/-
Copyright (c) 2021 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Bhavik Mehta

! This file was ported from Lean 3 source module measure_theory.integral.integral_eq_improper
! 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.MeasureTheory.Integral.IntervalIntegral
import Mathbin.Order.Filter.AtTopBot
import Mathbin.MeasureTheory.Function.Jacobian

/-!
# Links between an integral and its "improper" version

In its current state, mathlib only knows how to talk about definite ("proper") integrals,
in the sense that it treats integrals over `[x, +∞)` the same as it treats integrals over
`[y, z]`. For example, the integral over `[1, +∞)` is **not** defined to be the limit of
the integral over `[1, x]` as `x` tends to `+∞`, which is known as an **improper integral**.

Indeed, the "proper" definition is stronger than the "improper" one. The usual counterexample
is `x ↦ sin(x)/x`, which has an improper integral over `[1, +∞)` but no definite integral.

Although definite integrals have better properties, they are hardly usable when it comes to
computing integrals on unbounded sets, which is much easier using limits. Thus, in this file,
we prove various ways of studying the proper integral by studying the improper one.

## Definitions

The main definition of this file is `measure_theory.ae_cover`. It is a rather technical
definition whose sole purpose is generalizing and factoring proofs. Given an index type `ι`, a
countably generated filter `l` over `ι`, and an `ι`-indexed family `φ` of subsets of a measurable
space `α` equipped with a measure `μ`, one should think of a hypothesis `hφ : ae_cover μ l φ` as
a sufficient condition for being able to interpret `∫ x, f x ∂μ` (if it exists) as the limit
of `∫ x in φ i, f x ∂μ` as `i` tends to `l`.

When using this definition with a measure restricted to a set `s`, which happens fairly often,
one should not try too hard to use a `ae_cover` of subsets of `s`, as it often makes proofs
more complicated than necessary. See for example the proof of
`measure_theory.integrable_on_Iic_of_interval_integral_norm_tendsto` where we use `(λ x, Ioi x)`
as an `ae_cover` w.r.t. `μ.restrict (Iic b)`, instead of using `(λ x, Ioc x b)`.

## Main statements

- `measure_theory.ae_cover.lintegral_tendsto_of_countably_generated` : if `φ` is a `ae_cover μ l`,
  where `l` is a countably generated filter, and if `f` is a measurable `ennreal`-valued function,
  then `∫⁻ x in φ n, f x ∂μ` tends to `∫⁻ x, f x ∂μ` as `n` tends to `l`
- `measure_theory.ae_cover.integrable_of_integral_norm_tendsto` : if `φ` is a `ae_cover μ l`,
  where `l` is a countably generated filter, if `f` is measurable and integrable on each `φ n`,
  and if `∫ x in φ n, ‖f x‖ ∂μ` tends to some `I : ℝ` as n tends to `l`, then `f` is integrable
- `measure_theory.ae_cover.integral_tendsto_of_countably_generated` : if `φ` is a `ae_cover μ l`,
  where `l` is a countably generated filter, and if `f` is measurable and integrable (globally),
  then `∫ x in φ n, f x ∂μ` tends to `∫ x, f x ∂μ` as `n` tends to `+∞`.

We then specialize these lemmas to various use cases involving intervals, which are frequent
in analysis.
-/

open MeasureTheory Filter Set TopologicalSpace

open ENNReal NNReal Topology

namespace MeasureTheory

section AeCover

variable {α ι : Type _} [MeasurableSpace α] (μ : Measure α) (l : Filter ι)

/-- A sequence `φ` of subsets of `α` is a `ae_cover` w.r.t. a measure `μ` and a filter `l`
    if almost every point (w.r.t. `μ`) of `α` eventually belongs to `φ n` (w.r.t. `l`), and if
    each `φ n` is measurable.
    This definition is a technical way to avoid duplicating a lot of proofs.
    It should be thought of as a sufficient condition for being able to interpret
    `∫ x, f x ∂μ` (if it exists) as the limit of `∫ x in φ n, f x ∂μ` as `n` tends to `l`.

    See for example `measure_theory.ae_cover.lintegral_tendsto_of_countably_generated`,
    `measure_theory.ae_cover.integrable_of_integral_norm_tendsto` and
    `measure_theory.ae_cover.integral_tendsto_of_countably_generated`. -/
structure AeCover (φ : ι → Set α) : Prop where
  ae_eventually_mem : ∀ᵐ x ∂μ, ∀ᶠ i in l, x ∈ φ i
  Measurable : ∀ i, MeasurableSet <| φ i
#align measure_theory.ae_cover MeasureTheory.AeCover

variable {μ} {l}

section Preorderα

variable [Preorder α] [TopologicalSpace α] [OrderClosedTopology α] [OpensMeasurableSpace α]
  {a b : ι → α} (ha : Tendsto a l atBot) (hb : Tendsto b l atTop)

theorem aeCoverIcc : AeCover μ l fun i => Icc (a i) (b i) :=
  { ae_eventually_mem :=
      ae_of_all μ fun x =>
        (ha.Eventually <| eventually_le_atBot x).mp <|
          (hb.Eventually <| eventually_ge_atTop x).mono fun i hbi hai => ⟨hai, hbi⟩
    Measurable := fun i => measurableSet_Icc }
#align measure_theory.ae_cover_Icc MeasureTheory.aeCoverIcc

theorem aeCoverIci : AeCover μ l fun i => Ici <| a i :=
  { ae_eventually_mem :=
      ae_of_all μ fun x => (ha.Eventually <| eventually_le_atBot x).mono fun i hai => hai
    Measurable := fun i => measurableSet_Ici }
#align measure_theory.ae_cover_Ici MeasureTheory.aeCoverIci

theorem aeCoverIic : AeCover μ l fun i => Iic <| b i :=
  { ae_eventually_mem :=
      ae_of_all μ fun x => (hb.Eventually <| eventually_ge_atTop x).mono fun i hbi => hbi
    Measurable := fun i => measurableSet_Iic }
#align measure_theory.ae_cover_Iic MeasureTheory.aeCoverIic

end Preorderα

section LinearOrderα

variable [LinearOrder α] [TopologicalSpace α] [OrderClosedTopology α] [OpensMeasurableSpace α]
  {a b : ι → α} (ha : Tendsto a l atBot) (hb : Tendsto b l atTop)

theorem aeCoverIoo [NoMinOrder α] [NoMaxOrder α] : AeCover μ l fun i => Ioo (a i) (b i) :=
  { ae_eventually_mem :=
      ae_of_all μ fun x =>
        (ha.Eventually <| eventually_lt_atBot x).mp <|
          (hb.Eventually <| eventually_gt_atTop x).mono fun i hbi hai => ⟨hai, hbi⟩
    Measurable := fun i => measurableSet_Ioo }
#align measure_theory.ae_cover_Ioo MeasureTheory.aeCoverIoo

theorem aeCoverIoc [NoMinOrder α] : AeCover μ l fun i => Ioc (a i) (b i) :=
  { ae_eventually_mem :=
      ae_of_all μ fun x =>
        (ha.Eventually <| eventually_lt_atBot x).mp <|
          (hb.Eventually <| eventually_ge_atTop x).mono fun i hbi hai => ⟨hai, hbi⟩
    Measurable := fun i => measurableSet_Ioc }
#align measure_theory.ae_cover_Ioc MeasureTheory.aeCoverIoc

theorem aeCoverIco [NoMaxOrder α] : AeCover μ l fun i => Ico (a i) (b i) :=
  { ae_eventually_mem :=
      ae_of_all μ fun x =>
        (ha.Eventually <| eventually_le_atBot x).mp <|
          (hb.Eventually <| eventually_gt_atTop x).mono fun i hbi hai => ⟨hai, hbi⟩
    Measurable := fun i => measurableSet_Ico }
#align measure_theory.ae_cover_Ico MeasureTheory.aeCoverIco

theorem aeCoverIoi [NoMinOrder α] : AeCover μ l fun i => Ioi <| a i :=
  { ae_eventually_mem :=
      ae_of_all μ fun x => (ha.Eventually <| eventually_lt_atBot x).mono fun i hai => hai
    Measurable := fun i => measurableSet_Ioi }
#align measure_theory.ae_cover_Ioi MeasureTheory.aeCoverIoi

theorem aeCoverIio [NoMaxOrder α] : AeCover μ l fun i => Iio <| b i :=
  { ae_eventually_mem :=
      ae_of_all μ fun x => (hb.Eventually <| eventually_gt_atTop x).mono fun i hbi => hbi
    Measurable := fun i => measurableSet_Iio }
#align measure_theory.ae_cover_Iio MeasureTheory.aeCoverIio

end LinearOrderα

section FiniteIntervals

variable [LinearOrder α] [TopologicalSpace α] [OrderClosedTopology α] [OpensMeasurableSpace α]
  {a b : ι → α} {A B : α} (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B))

theorem aeCoverIooOfIcc : AeCover (μ.restrict <| Ioo A B) l fun i => Icc (a i) (b i) :=
  { ae_eventually_mem :=
      (ae_restrict_iff' measurableSet_Ioo).mpr
        (ae_of_all μ fun x hx =>
          (ha.Eventually <| eventually_le_nhds hx.left).mp <|
            (hb.Eventually <| eventually_ge_nhds hx.right).mono fun i hbi hai => ⟨hai, hbi⟩)
    Measurable := fun i => measurableSet_Icc }
#align measure_theory.ae_cover_Ioo_of_Icc MeasureTheory.aeCoverIooOfIcc

theorem aeCoverIooOfIco : AeCover (μ.restrict <| Ioo A B) l fun i => Ico (a i) (b i) :=
  { ae_eventually_mem :=
      (ae_restrict_iff' measurableSet_Ioo).mpr
        (ae_of_all μ fun x hx =>
          (ha.Eventually <| eventually_le_nhds hx.left).mp <|
            (hb.Eventually <| eventually_gt_nhds hx.right).mono fun i hbi hai => ⟨hai, hbi⟩)
    Measurable := fun i => measurableSet_Ico }
#align measure_theory.ae_cover_Ioo_of_Ico MeasureTheory.aeCoverIooOfIco

theorem aeCoverIooOfIoc : AeCover (μ.restrict <| Ioo A B) l fun i => Ioc (a i) (b i) :=
  { ae_eventually_mem :=
      (ae_restrict_iff' measurableSet_Ioo).mpr
        (ae_of_all μ fun x hx =>
          (ha.Eventually <| eventually_lt_nhds hx.left).mp <|
            (hb.Eventually <| eventually_ge_nhds hx.right).mono fun i hbi hai => ⟨hai, hbi⟩)
    Measurable := fun i => measurableSet_Ioc }
#align measure_theory.ae_cover_Ioo_of_Ioc MeasureTheory.aeCoverIooOfIoc

theorem aeCoverIooOfIoo : AeCover (μ.restrict <| Ioo A B) l fun i => Ioo (a i) (b i) :=
  { ae_eventually_mem :=
      (ae_restrict_iff' measurableSet_Ioo).mpr
        (ae_of_all μ fun x hx =>
          (ha.Eventually <| eventually_lt_nhds hx.left).mp <|
            (hb.Eventually <| eventually_gt_nhds hx.right).mono fun i hbi hai => ⟨hai, hbi⟩)
    Measurable := fun i => measurableSet_Ioo }
#align measure_theory.ae_cover_Ioo_of_Ioo MeasureTheory.aeCoverIooOfIoo

variable [HasNoAtoms μ]

theorem aeCoverIocOfIcc (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ioc A B) l fun i => Icc (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Icc ha hb]
#align measure_theory.ae_cover_Ioc_of_Icc MeasureTheory.aeCoverIocOfIcc

theorem aeCoverIocOfIco (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ioc A B) l fun i => Ico (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Ico ha hb]
#align measure_theory.ae_cover_Ioc_of_Ico MeasureTheory.aeCoverIocOfIco

theorem aeCoverIocOfIoc (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ioc A B) l fun i => Ioc (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Ioc ha hb]
#align measure_theory.ae_cover_Ioc_of_Ioc MeasureTheory.aeCoverIocOfIoc

theorem aeCoverIocOfIoo (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ioc A B) l fun i => Ioo (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Ioo ha hb]
#align measure_theory.ae_cover_Ioc_of_Ioo MeasureTheory.aeCoverIocOfIoo

theorem aeCoverIcoOfIcc (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ico A B) l fun i => Icc (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Icc ha hb]
#align measure_theory.ae_cover_Ico_of_Icc MeasureTheory.aeCoverIcoOfIcc

theorem aeCoverIcoOfIco (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ico A B) l fun i => Ico (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Ico ha hb]
#align measure_theory.ae_cover_Ico_of_Ico MeasureTheory.aeCoverIcoOfIco

theorem aeCoverIcoOfIoc (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ico A B) l fun i => Ioc (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Ioc ha hb]
#align measure_theory.ae_cover_Ico_of_Ioc MeasureTheory.aeCoverIcoOfIoc

theorem aeCoverIcoOfIoo (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Ico A B) l fun i => Ioo (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Ioo ha hb]
#align measure_theory.ae_cover_Ico_of_Ioo MeasureTheory.aeCoverIcoOfIoo

theorem aeCoverIccOfIcc (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Icc A B) l fun i => Icc (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Icc ha hb]
#align measure_theory.ae_cover_Icc_of_Icc MeasureTheory.aeCoverIccOfIcc

theorem aeCoverIccOfIco (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Icc A B) l fun i => Ico (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Ico ha hb]
#align measure_theory.ae_cover_Icc_of_Ico MeasureTheory.aeCoverIccOfIco

theorem aeCoverIccOfIoc (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Icc A B) l fun i => Ioc (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Ioc ha hb]
#align measure_theory.ae_cover_Icc_of_Ioc MeasureTheory.aeCoverIccOfIoc

theorem aeCoverIccOfIoo (ha : Tendsto a l (𝓝 A)) (hb : Tendsto b l (𝓝 B)) :
    AeCover (μ.restrict <| Icc A B) l fun i => Ioo (a i) (b i) := by
  simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Ioo ha hb]
#align measure_theory.ae_cover_Icc_of_Ioo MeasureTheory.aeCoverIccOfIoo

end FiniteIntervals

theorem AeCover.restrict {φ : ι → Set α} (hφ : AeCover μ l φ) {s : Set α} :
    AeCover (μ.restrict s) l φ :=
  { ae_eventually_mem := ae_restrict_of_ae hφ.ae_eventually_mem
    Measurable := hφ.Measurable }
#align measure_theory.ae_cover.restrict MeasureTheory.AeCover.restrict

theorem aeCoverRestrictOfAeImp {s : Set α} {φ : ι → Set α} (hs : MeasurableSet s)
    (ae_eventually_mem : ∀ᵐ x ∂μ, x ∈ s → ∀ᶠ n in l, x ∈ φ n)
    (measurable : ∀ n, MeasurableSet <| φ n) : AeCover (μ.restrict s) l φ :=
  { ae_eventually_mem := by rwa [ae_restrict_iff' hs]
    Measurable }
#align measure_theory.ae_cover_restrict_of_ae_imp MeasureTheory.aeCoverRestrictOfAeImp

theorem AeCover.interRestrict {φ : ι → Set α} (hφ : AeCover μ l φ) {s : Set α}
    (hs : MeasurableSet s) : AeCover (μ.restrict s) l fun i => φ i ∩ s :=
  aeCoverRestrictOfAeImp hs
    (hφ.ae_eventually_mem.mono fun x hx hxs => hx.mono fun i hi => ⟨hi, hxs⟩) fun i =>
    (hφ.Measurable i).inter hs
#align measure_theory.ae_cover.inter_restrict MeasureTheory.AeCover.interRestrict

theorem AeCover.ae_tendsto_indicator {β : Type _} [Zero β] [TopologicalSpace β] (f : α → β)
    {φ : ι → Set α} (hφ : AeCover μ l φ) :
    ∀ᵐ x ∂μ, Tendsto (fun i => (φ i).indicator f x) l (𝓝 <| f x) :=
  hφ.ae_eventually_mem.mono fun x hx =>
    tendsto_const_nhds.congr' <| hx.mono fun n hn => (indicator_of_mem hn _).symm
#align measure_theory.ae_cover.ae_tendsto_indicator MeasureTheory.AeCover.ae_tendsto_indicator

theorem AeCover.aeMeasurable {β : Type _} [MeasurableSpace β] [l.IsCountablyGenerated] [l.ne_bot]
    {f : α → β} {φ : ι → Set α} (hφ : AeCover μ l φ)
    (hfm : ∀ i, AeMeasurable f (μ.restrict <| φ i)) : AeMeasurable f μ :=
  by
  obtain ⟨u, hu⟩ := l.exists_seq_tendsto
  have := ae_measurable_Union_iff.mpr fun n : ℕ => hfm (u n)
  rwa [measure.restrict_eq_self_of_ae_mem] at this
  filter_upwards [hφ.ae_eventually_mem]with x hx using let ⟨i, hi⟩ := (hu.eventually hx).exists
    mem_Union.mpr ⟨i, hi⟩
#align measure_theory.ae_cover.ae_measurable MeasureTheory.AeCover.aeMeasurable

theorem AeCover.aeStronglyMeasurable {β : Type _} [TopologicalSpace β] [PseudoMetrizableSpace β]
    [l.IsCountablyGenerated] [l.ne_bot] {f : α → β} {φ : ι → Set α} (hφ : AeCover μ l φ)
    (hfm : ∀ i, AeStronglyMeasurable f (μ.restrict <| φ i)) : AeStronglyMeasurable f μ :=
  by
  obtain ⟨u, hu⟩ := l.exists_seq_tendsto
  have := ae_strongly_measurable_Union_iff.mpr fun n : ℕ => hfm (u n)
  rwa [measure.restrict_eq_self_of_ae_mem] at this
  filter_upwards [hφ.ae_eventually_mem]with x hx using let ⟨i, hi⟩ := (hu.eventually hx).exists
    mem_Union.mpr ⟨i, hi⟩
#align measure_theory.ae_cover.ae_strongly_measurable MeasureTheory.AeCover.aeStronglyMeasurable

end AeCover

theorem AeCover.compTendsto {α ι ι' : Type _} [MeasurableSpace α] {μ : Measure α} {l : Filter ι}
    {l' : Filter ι'} {φ : ι → Set α} (hφ : AeCover μ l φ) {u : ι' → ι} (hu : Tendsto u l' l) :
    AeCover μ l' (φ ∘ u) :=
  { ae_eventually_mem := hφ.ae_eventually_mem.mono fun x hx => hu.Eventually hx
    Measurable := fun i => hφ.Measurable (u i) }
#align measure_theory.ae_cover.comp_tendsto MeasureTheory.AeCover.compTendsto

section AeCoverUnionInterCountable

variable {α ι : Type _} [Countable ι] [MeasurableSpace α] {μ : Measure α}

theorem AeCover.bUnionIicAeCover [Preorder ι] {φ : ι → Set α} (hφ : AeCover μ atTop φ) :
    AeCover μ atTop fun n : ι => ⋃ (k) (h : k ∈ Iic n), φ k :=
  { ae_eventually_mem :=
      hφ.ae_eventually_mem.mono fun x h => h.mono fun i hi => mem_bunionᵢ right_mem_Iic hi
    Measurable := fun i => MeasurableSet.bunionᵢ (to_countable _) fun n _ => hφ.Measurable n }
#align measure_theory.ae_cover.bUnion_Iic_ae_cover MeasureTheory.AeCover.bUnionIicAeCover

theorem AeCover.bInterIciAeCover [SemilatticeSup ι] [Nonempty ι] {φ : ι → Set α}
    (hφ : AeCover μ atTop φ) : AeCover μ atTop fun n : ι => ⋂ (k) (h : k ∈ Ici n), φ k :=
  { ae_eventually_mem :=
      hφ.ae_eventually_mem.mono
        (by
          intro x h
          rw [eventually_at_top] at *
          rcases h with ⟨i, hi⟩
          use i
          intro j hj
          exact mem_bInter fun k hk => hi k (le_trans hj hk))
    Measurable := fun i => MeasurableSet.binterᵢ (to_countable _) fun n _ => hφ.Measurable n }
#align measure_theory.ae_cover.bInter_Ici_ae_cover MeasureTheory.AeCover.bInterIciAeCover

end AeCoverUnionInterCountable

section Lintegral

variable {α ι : Type _} [MeasurableSpace α] {μ : Measure α} {l : Filter ι}

private theorem lintegral_tendsto_of_monotone_of_nat {φ : ℕ → Set α} (hφ : AeCover μ atTop φ)
    (hmono : Monotone φ) {f : α → ℝ≥0∞} (hfm : AeMeasurable f μ) :
    Tendsto (fun i => ∫⁻ x in φ i, f x ∂μ) atTop (𝓝 <| ∫⁻ x, f x ∂μ) :=
  let F n := (φ n).indicator f
  have key₁ : ∀ n, AeMeasurable (F n) μ := fun n => hfm.indicator (hφ.Measurable n)
  have key₂ : ∀ᵐ x : α ∂μ, Monotone fun n => F n x :=
    ae_of_all _ fun x i j hij =>
      indicator_le_indicator_of_subset (hmono hij) (fun x => zero_le <| f x) x
  have key₃ : ∀ᵐ x : α ∂μ, Tendsto (fun n => F n x) atTop (𝓝 (f x)) := hφ.ae_tendsto_indicator f
  (lintegral_tendsto_of_tendsto_of_monotone key₁ key₂ key₃).congr fun n =>
    lintegral_indicator f (hφ.Measurable n)
#align measure_theory.lintegral_tendsto_of_monotone_of_nat measure_theory.lintegral_tendsto_of_monotone_of_nat

theorem AeCover.lintegral_tendsto_of_nat {φ : ℕ → Set α} (hφ : AeCover μ atTop φ) {f : α → ℝ≥0∞}
    (hfm : AeMeasurable f μ) : Tendsto (fun i => ∫⁻ x in φ i, f x ∂μ) atTop (𝓝 <| ∫⁻ x, f x ∂μ) :=
  by
  have lim₁ :=
    lintegral_tendsto_of_monotone_of_nat hφ.bInter_Ici_ae_cover
      (fun i j hij => bInter_subset_bInter_left (Ici_subset_Ici.mpr hij)) hfm
  have lim₂ :=
    lintegral_tendsto_of_monotone_of_nat hφ.bUnion_Iic_ae_cover
      (fun i j hij => bUnion_subset_bUnion_left (Iic_subset_Iic.mpr hij)) hfm
  have le₁ := fun n => lintegral_mono_set (bInter_subset_of_mem left_mem_Ici)
  have le₂ := fun n => lintegral_mono_set (subset_bUnion_of_mem right_mem_Iic)
  exact tendsto_of_tendsto_of_tendsto_of_le_of_le lim₁ lim₂ le₁ le₂
#align measure_theory.ae_cover.lintegral_tendsto_of_nat MeasureTheory.AeCover.lintegral_tendsto_of_nat

theorem AeCover.lintegral_tendsto_of_countably_generated [l.IsCountablyGenerated] {φ : ι → Set α}
    (hφ : AeCover μ l φ) {f : α → ℝ≥0∞} (hfm : AeMeasurable f μ) :
    Tendsto (fun i => ∫⁻ x in φ i, f x ∂μ) l (𝓝 <| ∫⁻ x, f x ∂μ) :=
  tendsto_of_seq_tendsto fun u hu => (hφ.comp_tendsto hu).lintegral_tendsto_of_nat hfm
#align measure_theory.ae_cover.lintegral_tendsto_of_countably_generated MeasureTheory.AeCover.lintegral_tendsto_of_countably_generated

theorem AeCover.lintegral_eq_of_tendsto [l.ne_bot] [l.IsCountablyGenerated] {φ : ι → Set α}
    (hφ : AeCover μ l φ) {f : α → ℝ≥0∞} (I : ℝ≥0∞) (hfm : AeMeasurable f μ)
    (htendsto : Tendsto (fun i => ∫⁻ x in φ i, f x ∂μ) l (𝓝 I)) : (∫⁻ x, f x ∂μ) = I :=
  tendsto_nhds_unique (hφ.lintegral_tendsto_of_countably_generated hfm) htendsto
#align measure_theory.ae_cover.lintegral_eq_of_tendsto MeasureTheory.AeCover.lintegral_eq_of_tendsto

theorem AeCover.supᵢ_lintegral_eq_of_countably_generated [Nonempty ι] [l.ne_bot]
    [l.IsCountablyGenerated] {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → ℝ≥0∞}
    (hfm : AeMeasurable f μ) : (⨆ i : ι, ∫⁻ x in φ i, f x ∂μ) = ∫⁻ x, f x ∂μ :=
  by
  have := hφ.lintegral_tendsto_of_countably_generated hfm
  refine'
    csupᵢ_eq_of_forall_le_of_forall_lt_exists_gt
      (fun i => lintegral_mono' measure.restrict_le_self le_rfl) fun w hw => _
  rcases exists_between hw with ⟨m, hm₁, hm₂⟩
  rcases(eventually_ge_of_tendsto_gt hm₂ this).exists with ⟨i, hi⟩
  exact ⟨i, lt_of_lt_of_le hm₁ hi⟩
#align measure_theory.ae_cover.supr_lintegral_eq_of_countably_generated MeasureTheory.AeCover.supᵢ_lintegral_eq_of_countably_generated

end Lintegral

section Integrable

variable {α ι E : Type _} [MeasurableSpace α] {μ : Measure α} {l : Filter ι} [NormedAddCommGroup E]

theorem AeCover.integrableOfLintegralNnnormBounded [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → E} (I : ℝ) (hfm : AeStronglyMeasurable f μ)
    (hbounded : ∀ᶠ i in l, (∫⁻ x in φ i, ‖f x‖₊ ∂μ) ≤ ENNReal.ofReal I) : Integrable f μ :=
  by
  refine' ⟨hfm, (le_of_tendsto _ hbounded).trans_lt ENNReal.ofReal_lt_top⟩
  exact hφ.lintegral_tendsto_of_countably_generated hfm.ennnorm
#align measure_theory.ae_cover.integrable_of_lintegral_nnnorm_bounded MeasureTheory.AeCover.integrableOfLintegralNnnormBounded

theorem AeCover.integrableOfLintegralNnnormTendsto [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → E} (I : ℝ) (hfm : AeStronglyMeasurable f μ)
    (htendsto : Tendsto (fun i => ∫⁻ x in φ i, ‖f x‖₊ ∂μ) l (𝓝 <| ENNReal.ofReal I)) :
    Integrable f μ :=
  by
  refine' hφ.integrable_of_lintegral_nnnorm_bounded (max 1 (I + 1)) hfm _
  refine' htendsto.eventually (ge_mem_nhds _)
  refine' (ENNReal.ofReal_lt_ofReal_iff (lt_max_of_lt_left zero_lt_one)).2 _
  exact lt_max_of_lt_right (lt_add_one I)
#align measure_theory.ae_cover.integrable_of_lintegral_nnnorm_tendsto MeasureTheory.AeCover.integrableOfLintegralNnnormTendsto

theorem AeCover.integrableOfLintegralNnnormBounded' [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → E} (I : ℝ≥0) (hfm : AeStronglyMeasurable f μ)
    (hbounded : ∀ᶠ i in l, (∫⁻ x in φ i, ‖f x‖₊ ∂μ) ≤ I) : Integrable f μ :=
  hφ.integrableOfLintegralNnnormBounded I hfm
    (by simpa only [ENNReal.ofReal_coe_nnreal] using hbounded)
#align measure_theory.ae_cover.integrable_of_lintegral_nnnorm_bounded' MeasureTheory.AeCover.integrableOfLintegralNnnormBounded'

theorem AeCover.integrableOfLintegralNnnormTendsto' [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → E} (I : ℝ≥0) (hfm : AeStronglyMeasurable f μ)
    (htendsto : Tendsto (fun i => ∫⁻ x in φ i, ‖f x‖₊ ∂μ) l (𝓝 I)) : Integrable f μ :=
  hφ.integrableOfLintegralNnnormTendsto I hfm
    (by simpa only [ENNReal.ofReal_coe_nnreal] using htendsto)
#align measure_theory.ae_cover.integrable_of_lintegral_nnnorm_tendsto' MeasureTheory.AeCover.integrableOfLintegralNnnormTendsto'

theorem AeCover.integrableOfIntegralNormBounded [l.ne_bot] [l.IsCountablyGenerated] {φ : ι → Set α}
    (hφ : AeCover μ l φ) {f : α → E} (I : ℝ) (hfi : ∀ i, IntegrableOn f (φ i) μ)
    (hbounded : ∀ᶠ i in l, (∫ x in φ i, ‖f x‖ ∂μ) ≤ I) : Integrable f μ :=
  by
  have hfm : ae_strongly_measurable f μ :=
    hφ.ae_strongly_measurable fun i => (hfi i).AeStronglyMeasurable
  refine' hφ.integrable_of_lintegral_nnnorm_bounded I hfm _
  conv at hbounded in integral _ _ =>
    rw [integral_eq_lintegral_of_nonneg_ae (ae_of_all _ fun x => @norm_nonneg E _ (f x))
        hfm.norm.restrict]
  conv at hbounded in ENNReal.ofReal _ =>
    dsimp
    rw [← coe_nnnorm]
    rw [ENNReal.ofReal_coe_nnreal]
  refine' hbounded.mono fun i hi => _
  rw [← ENNReal.ofReal_toReal (ne_top_of_lt (hfi i).2)]
  apply ENNReal.ofReal_le_ofReal hi
#align measure_theory.ae_cover.integrable_of_integral_norm_bounded MeasureTheory.AeCover.integrableOfIntegralNormBounded

theorem AeCover.integrableOfIntegralNormTendsto [l.ne_bot] [l.IsCountablyGenerated] {φ : ι → Set α}
    (hφ : AeCover μ l φ) {f : α → E} (I : ℝ) (hfi : ∀ i, IntegrableOn f (φ i) μ)
    (htendsto : Tendsto (fun i => ∫ x in φ i, ‖f x‖ ∂μ) l (𝓝 I)) : Integrable f μ :=
  let ⟨I', hI'⟩ := htendsto.isBoundedUnder_le
  hφ.integrableOfIntegralNormBounded I' hfi hI'
#align measure_theory.ae_cover.integrable_of_integral_norm_tendsto MeasureTheory.AeCover.integrableOfIntegralNormTendsto

theorem AeCover.integrableOfIntegralBoundedOfNonnegAe [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → ℝ} (I : ℝ) (hfi : ∀ i, IntegrableOn f (φ i) μ)
    (hnng : ∀ᵐ x ∂μ, 0 ≤ f x) (hbounded : ∀ᶠ i in l, (∫ x in φ i, f x ∂μ) ≤ I) : Integrable f μ :=
  hφ.integrableOfIntegralNormBounded I hfi <|
    hbounded.mono fun i hi =>
      (integral_congr_ae <| ae_restrict_of_ae <| hnng.mono fun x => Real.norm_of_nonneg).le.trans hi
#align measure_theory.ae_cover.integrable_of_integral_bounded_of_nonneg_ae MeasureTheory.AeCover.integrableOfIntegralBoundedOfNonnegAe

theorem AeCover.integrableOfIntegralTendstoOfNonnegAe [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → ℝ} (I : ℝ) (hfi : ∀ i, IntegrableOn f (φ i) μ)
    (hnng : ∀ᵐ x ∂μ, 0 ≤ f x) (htendsto : Tendsto (fun i => ∫ x in φ i, f x ∂μ) l (𝓝 I)) :
    Integrable f μ :=
  let ⟨I', hI'⟩ := htendsto.isBoundedUnder_le
  hφ.integrableOfIntegralBoundedOfNonnegAe I' hfi hnng hI'
#align measure_theory.ae_cover.integrable_of_integral_tendsto_of_nonneg_ae MeasureTheory.AeCover.integrableOfIntegralTendstoOfNonnegAe

end Integrable

section Integral

variable {α ι E : Type _} [MeasurableSpace α] {μ : Measure α} {l : Filter ι} [NormedAddCommGroup E]
  [NormedSpace ℝ E] [CompleteSpace E]

theorem AeCover.integral_tendsto_of_countably_generated [l.IsCountablyGenerated] {φ : ι → Set α}
    (hφ : AeCover μ l φ) {f : α → E} (hfi : Integrable f μ) :
    Tendsto (fun i => ∫ x in φ i, f x ∂μ) l (𝓝 <| ∫ x, f x ∂μ) :=
  suffices h : Tendsto (fun i => ∫ x : α, (φ i).indicator f x ∂μ) l (𝓝 (∫ x : α, f x ∂μ)) from
    by
    convert h
    ext n
    rw [integral_indicator (hφ.measurable n)]
  tendsto_integral_filter_of_dominated_convergence (fun x => ‖f x‖)
    (eventually_of_forall fun i => hfi.AeStronglyMeasurable.indicator <| hφ.Measurable i)
    (eventually_of_forall fun i => ae_of_all _ fun x => norm_indicator_le_norm_self _ _) hfi.norm
    (hφ.ae_tendsto_indicator f)
#align measure_theory.ae_cover.integral_tendsto_of_countably_generated MeasureTheory.AeCover.integral_tendsto_of_countably_generated

/-- Slight reformulation of
    `measure_theory.ae_cover.integral_tendsto_of_countably_generated`. -/
theorem AeCover.integral_eq_of_tendsto [l.ne_bot] [l.IsCountablyGenerated] {φ : ι → Set α}
    (hφ : AeCover μ l φ) {f : α → E} (I : E) (hfi : Integrable f μ)
    (h : Tendsto (fun n => ∫ x in φ n, f x ∂μ) l (𝓝 I)) : (∫ x, f x ∂μ) = I :=
  tendsto_nhds_unique (hφ.integral_tendsto_of_countably_generated hfi) h
#align measure_theory.ae_cover.integral_eq_of_tendsto MeasureTheory.AeCover.integral_eq_of_tendsto

theorem AeCover.integral_eq_of_tendsto_of_nonneg_ae [l.ne_bot] [l.IsCountablyGenerated]
    {φ : ι → Set α} (hφ : AeCover μ l φ) {f : α → ℝ} (I : ℝ) (hnng : 0 ≤ᵐ[μ] f)
    (hfi : ∀ n, IntegrableOn f (φ n) μ) (htendsto : Tendsto (fun n => ∫ x in φ n, f x ∂μ) l (𝓝 I)) :
    (∫ x, f x ∂μ) = I :=
  have hfi' : Integrable f μ := hφ.integrableOfIntegralTendstoOfNonnegAe I hfi hnng htendsto
  hφ.integral_eq_of_tendsto I hfi' htendsto
#align measure_theory.ae_cover.integral_eq_of_tendsto_of_nonneg_ae MeasureTheory.AeCover.integral_eq_of_tendsto_of_nonneg_ae

end Integral

section IntegrableOfIntervalIntegral

variable {ι E : Type _} {μ : Measure ℝ} {l : Filter ι} [Filter.NeBot l] [IsCountablyGenerated l]
  [NormedAddCommGroup E] {a b : ι → ℝ} {f : ℝ → E}

theorem integrableOfIntervalIntegralNormBounded (I : ℝ)
    (hfi : ∀ i, IntegrableOn f (Ioc (a i) (b i)) μ) (ha : Tendsto a l atBot)
    (hb : Tendsto b l atTop) (h : ∀ᶠ i in l, (∫ x in a i..b i, ‖f x‖ ∂μ) ≤ I) : Integrable f μ :=
  by
  have hφ : ae_cover μ l _ := ae_cover_Ioc ha hb
  refine' hφ.integrable_of_integral_norm_bounded I hfi (h.mp _)
  filter_upwards [ha.eventually (eventually_le_at_bot 0),
    hb.eventually (eventually_ge_at_top 0)]with i hai hbi ht
  rwa [← intervalIntegral.integral_of_le (hai.trans hbi)]
#align measure_theory.integrable_of_interval_integral_norm_bounded MeasureTheory.integrableOfIntervalIntegralNormBounded

/-- If `f` is integrable on intervals `Ioc (a i) (b i)`,
where `a i` tends to -∞ and `b i` tends to ∞, and
`∫ x in a i .. b i, ‖f x‖ ∂μ` converges to `I : ℝ` along a filter `l`,
then `f` is integrable on the interval (-∞, ∞) -/
theorem integrableOfIntervalIntegralNormTendsto (I : ℝ)
    (hfi : ∀ i, IntegrableOn f (Ioc (a i) (b i)) μ) (ha : Tendsto a l atBot)
    (hb : Tendsto b l atTop) (h : Tendsto (fun i => ∫ x in a i..b i, ‖f x‖ ∂μ) l (𝓝 I)) :
    Integrable f μ :=
  let ⟨I', hI'⟩ := h.isBoundedUnder_le
  integrableOfIntervalIntegralNormBounded I' hfi ha hb hI'
#align measure_theory.integrable_of_interval_integral_norm_tendsto MeasureTheory.integrableOfIntervalIntegralNormTendsto

theorem integrableOnIicOfIntervalIntegralNormBounded (I b : ℝ)
    (hfi : ∀ i, IntegrableOn f (Ioc (a i) b) μ) (ha : Tendsto a l atBot)
    (h : ∀ᶠ i in l, (∫ x in a i..b, ‖f x‖ ∂μ) ≤ I) : IntegrableOn f (Iic b) μ :=
  by
  have hφ : ae_cover (μ.restrict <| Iic b) l _ := ae_cover_Ioi ha
  have hfi : ∀ i, integrable_on f (Ioi (a i)) (μ.restrict <| Iic b) :=
    by
    intro i
    rw [integrable_on, measure.restrict_restrict (hφ.measurable i)]
    exact hfi i
  refine' hφ.integrable_of_integral_norm_bounded I hfi (h.mp _)
  filter_upwards [ha.eventually (eventually_le_at_bot b)]with i hai
  rw [intervalIntegral.integral_of_le hai, measure.restrict_restrict (hφ.measurable i)]
  exact id
#align measure_theory.integrable_on_Iic_of_interval_integral_norm_bounded MeasureTheory.integrableOnIicOfIntervalIntegralNormBounded

/-- If `f` is integrable on intervals `Ioc (a i) b`,
where `a i` tends to -∞, and
`∫ x in a i .. b, ‖f x‖ ∂μ` converges to `I : ℝ` along a filter `l`,
then `f` is integrable on the interval (-∞, b) -/
theorem integrableOnIicOfIntervalIntegralNormTendsto (I b : ℝ)
    (hfi : ∀ i, IntegrableOn f (Ioc (a i) b) μ) (ha : Tendsto a l atBot)
    (h : Tendsto (fun i => ∫ x in a i..b, ‖f x‖ ∂μ) l (𝓝 I)) : IntegrableOn f (Iic b) μ :=
  let ⟨I', hI'⟩ := h.isBoundedUnder_le
  integrableOnIicOfIntervalIntegralNormBounded I' b hfi ha hI'
#align measure_theory.integrable_on_Iic_of_interval_integral_norm_tendsto MeasureTheory.integrableOnIicOfIntervalIntegralNormTendsto

theorem integrableOnIoiOfIntervalIntegralNormBounded (I a : ℝ)
    (hfi : ∀ i, IntegrableOn f (Ioc a (b i)) μ) (hb : Tendsto b l atTop)
    (h : ∀ᶠ i in l, (∫ x in a..b i, ‖f x‖ ∂μ) ≤ I) : IntegrableOn f (Ioi a) μ :=
  by
  have hφ : ae_cover (μ.restrict <| Ioi a) l _ := ae_cover_Iic hb
  have hfi : ∀ i, integrable_on f (Iic (b i)) (μ.restrict <| Ioi a) :=
    by
    intro i
    rw [integrable_on, measure.restrict_restrict (hφ.measurable i), inter_comm]
    exact hfi i
  refine' hφ.integrable_of_integral_norm_bounded I hfi (h.mp _)
  filter_upwards [hb.eventually (eventually_ge_at_top a)]with i hbi
  rw [intervalIntegral.integral_of_le hbi, measure.restrict_restrict (hφ.measurable i), inter_comm]
  exact id
#align measure_theory.integrable_on_Ioi_of_interval_integral_norm_bounded MeasureTheory.integrableOnIoiOfIntervalIntegralNormBounded

/-- If `f` is integrable on intervals `Ioc a (b i)`,
where `b i` tends to ∞, and
`∫ x in a .. b i, ‖f x‖ ∂μ` converges to `I : ℝ` along a filter `l`,
then `f` is integrable on the interval (a, ∞) -/
theorem integrableOnIoiOfIntervalIntegralNormTendsto (I a : ℝ)
    (hfi : ∀ i, IntegrableOn f (Ioc a (b i)) μ) (hb : Tendsto b l atTop)
    (h : Tendsto (fun i => ∫ x in a..b i, ‖f x‖ ∂μ) l (𝓝 <| I)) : IntegrableOn f (Ioi a) μ :=
  let ⟨I', hI'⟩ := h.isBoundedUnder_le
  integrableOnIoiOfIntervalIntegralNormBounded I' a hfi hb hI'
#align measure_theory.integrable_on_Ioi_of_interval_integral_norm_tendsto MeasureTheory.integrableOnIoiOfIntervalIntegralNormTendsto

theorem integrableOnIocOfIntervalIntegralNormBounded {I a₀ b₀ : ℝ}
    (hfi : ∀ i, IntegrableOn f <| Ioc (a i) (b i)) (ha : Tendsto a l <| 𝓝 a₀)
    (hb : Tendsto b l <| 𝓝 b₀) (h : ∀ᶠ i in l, (∫ x in Ioc (a i) (b i), ‖f x‖) ≤ I) :
    IntegrableOn f (Ioc a₀ b₀) :=
  by
  refine'
    (ae_cover_Ioc_of_Ioc ha hb).integrableOfIntegralNormBounded I
      (fun i => (hfi i).restrict measurableSet_Ioc) (eventually.mono h _)
  intro i hi; simp only [measure.restrict_restrict measurableSet_Ioc]
  refine' le_trans (set_integral_mono_set (hfi i).norm _ _) hi
  · apply ae_of_all
    simp only [Pi.zero_apply, norm_nonneg, forall_const]
  · apply ae_of_all
    intro c hc
    exact hc.1
#align measure_theory.integrable_on_Ioc_of_interval_integral_norm_bounded MeasureTheory.integrableOnIocOfIntervalIntegralNormBounded

theorem integrableOnIocOfIntervalIntegralNormBoundedLeft {I a₀ b : ℝ}
    (hfi : ∀ i, IntegrableOn f <| Ioc (a i) b) (ha : Tendsto a l <| 𝓝 a₀)
    (h : ∀ᶠ i in l, (∫ x in Ioc (a i) b, ‖f x‖) ≤ I) : IntegrableOn f (Ioc a₀ b) :=
  integrableOnIocOfIntervalIntegralNormBounded hfi ha tendsto_const_nhds h
#align measure_theory.integrable_on_Ioc_of_interval_integral_norm_bounded_left MeasureTheory.integrableOnIocOfIntervalIntegralNormBoundedLeft

theorem integrableOnIocOfIntervalIntegralNormBoundedRight {I a b₀ : ℝ}
    (hfi : ∀ i, IntegrableOn f <| Ioc a (b i)) (hb : Tendsto b l <| 𝓝 b₀)
    (h : ∀ᶠ i in l, (∫ x in Ioc a (b i), ‖f x‖) ≤ I) : IntegrableOn f (Ioc a b₀) :=
  integrableOnIocOfIntervalIntegralNormBounded hfi tendsto_const_nhds hb h
#align measure_theory.integrable_on_Ioc_of_interval_integral_norm_bounded_right MeasureTheory.integrableOnIocOfIntervalIntegralNormBoundedRight

end IntegrableOfIntervalIntegral

section IntegralOfIntervalIntegral

variable {ι E : Type _} {μ : Measure ℝ} {l : Filter ι} [IsCountablyGenerated l]
  [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E] {a b : ι → ℝ} {f : ℝ → E}

theorem intervalIntegral_tendsto_integral (hfi : Integrable f μ) (ha : Tendsto a l atBot)
    (hb : Tendsto b l atTop) : Tendsto (fun i => ∫ x in a i..b i, f x ∂μ) l (𝓝 <| ∫ x, f x ∂μ) :=
  by
  let φ i := Ioc (a i) (b i)
  have hφ : ae_cover μ l φ := ae_cover_Ioc ha hb
  refine' (hφ.integral_tendsto_of_countably_generated hfi).congr' _
  filter_upwards [ha.eventually (eventually_le_at_bot 0),
    hb.eventually (eventually_ge_at_top 0)]with i hai hbi
  exact (intervalIntegral.integral_of_le (hai.trans hbi)).symm
#align measure_theory.interval_integral_tendsto_integral MeasureTheory.intervalIntegral_tendsto_integral

theorem intervalIntegral_tendsto_integral_Iic (b : ℝ) (hfi : IntegrableOn f (Iic b) μ)
    (ha : Tendsto a l atBot) :
    Tendsto (fun i => ∫ x in a i..b, f x ∂μ) l (𝓝 <| ∫ x in Iic b, f x ∂μ) :=
  by
  let φ i := Ioi (a i)
  have hφ : ae_cover (μ.restrict <| Iic b) l φ := ae_cover_Ioi ha
  refine' (hφ.integral_tendsto_of_countably_generated hfi).congr' _
  filter_upwards [ha.eventually (eventually_le_at_bot <| b)]with i hai
  rw [intervalIntegral.integral_of_le hai, measure.restrict_restrict (hφ.measurable i)]
  rfl
#align measure_theory.interval_integral_tendsto_integral_Iic MeasureTheory.intervalIntegral_tendsto_integral_Iic

theorem intervalIntegral_tendsto_integral_Ioi (a : ℝ) (hfi : IntegrableOn f (Ioi a) μ)
    (hb : Tendsto b l atTop) :
    Tendsto (fun i => ∫ x in a..b i, f x ∂μ) l (𝓝 <| ∫ x in Ioi a, f x ∂μ) :=
  by
  let φ i := Iic (b i)
  have hφ : ae_cover (μ.restrict <| Ioi a) l φ := ae_cover_Iic hb
  refine' (hφ.integral_tendsto_of_countably_generated hfi).congr' _
  filter_upwards [hb.eventually (eventually_ge_at_top <| a)]with i hbi
  rw [intervalIntegral.integral_of_le hbi, measure.restrict_restrict (hφ.measurable i), inter_comm]
  rfl
#align measure_theory.interval_integral_tendsto_integral_Ioi MeasureTheory.intervalIntegral_tendsto_integral_Ioi

end IntegralOfIntervalIntegral

section IoiChangeVariables

open Real

open Interval

variable {E : Type _} {μ : Measure ℝ} {f : ℝ → E} [NormedAddCommGroup E] [NormedSpace ℝ E]
  [CompleteSpace E]

/-- Change-of-variables formula for `Ioi` integrals of vector-valued functions, proved by taking
limits from the result for finite intervals. -/
theorem integral_comp_smul_deriv_Ioi {f f' : ℝ → ℝ} {g : ℝ → E} {a : ℝ}
    (hf : ContinuousOn f <| Ici a) (hft : Tendsto f atTop atTop)
    (hff' : ∀ x ∈ Ioi a, HasDerivWithinAt f (f' x) (Ioi x) x)
    (hg_cont : ContinuousOn g <| f '' Ioi a) (hg1 : IntegrableOn g <| f '' Ici a)
    (hg2 : IntegrableOn (fun x => f' x • (g ∘ f) x) (Ici a)) :
    (∫ x in Ioi a, f' x • (g ∘ f) x) = ∫ u in Ioi (f a), g u :=
  by
  have eq : ∀ b : ℝ, a < b → (∫ x in a..b, f' x • (g ∘ f) x) = ∫ u in f a..f b, g u :=
    by
    intro b hb
    have i1 : Ioo (min a b) (max a b) ⊆ Ioi a :=
      by
      rw [min_eq_left hb.le]
      exact Ioo_subset_Ioi_self
    have i2 : [a, b] ⊆ Ici a := by
      rw [uIcc_of_le hb.le]
      exact Icc_subset_Ici_self
    refine'
      intervalIntegral.integral_comp_smul_deriv''' (hf.mono i2)
        (fun x hx => hff' x <| mem_of_mem_of_subset hx i1) (hg_cont.mono <| image_subset _ _)
        (hg1.mono_set <| image_subset _ _) (hg2.mono_set i2)
    · rw [min_eq_left hb.le]
      exact Ioo_subset_Ioi_self
    · rw [uIcc_of_le hb.le]
      exact Icc_subset_Ici_self
  rw [integrableOn_Ici_iff_integrableOn_Ioi] at hg2
  have t2 := interval_integral_tendsto_integral_Ioi _ hg2 tendsto_id
  have : Ioi (f a) ⊆ f '' Ici a :=
    Ioi_subset_Ici_self.trans <|
      IsPreconnected.intermediate_value_Ici isPreconnected_Ici left_mem_Ici
        (le_principal_iff.mpr <| Ici_mem_at_top _) hf hft
  have t1 := (interval_integral_tendsto_integral_Ioi _ (hg1.mono_set this) tendsto_id).comp hft
  exact tendsto_nhds_unique (tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top a) Eq) t2) t1
#align measure_theory.integral_comp_smul_deriv_Ioi MeasureTheory.integral_comp_smul_deriv_Ioi

/-- Change-of-variables formula for `Ioi` integrals of scalar-valued functions -/
theorem integral_comp_mul_deriv_Ioi {f f' : ℝ → ℝ} {g : ℝ → ℝ} {a : ℝ}
    (hf : ContinuousOn f <| Ici a) (hft : Tendsto f atTop atTop)
    (hff' : ∀ x ∈ Ioi a, HasDerivWithinAt f (f' x) (Ioi x) x)
    (hg_cont : ContinuousOn g <| f '' Ioi a) (hg1 : IntegrableOn g <| f '' Ici a)
    (hg2 : IntegrableOn (fun x => (g ∘ f) x * f' x) (Ici a)) :
    (∫ x in Ioi a, (g ∘ f) x * f' x) = ∫ u in Ioi (f a), g u :=
  by
  have hg2' : integrable_on (fun x => f' x • (g ∘ f) x) (Ici a) := by simpa [mul_comm] using hg2
  simpa [mul_comm] using integral_comp_smul_deriv_Ioi hf hft hff' hg_cont hg1 hg2'
#align measure_theory.integral_comp_mul_deriv_Ioi MeasureTheory.integral_comp_mul_deriv_Ioi

/-- Substitution `y = x ^ p` in integrals over `Ioi 0` -/
theorem integral_comp_rpow_Ioi (g : ℝ → E) {p : ℝ} (hp : p ≠ 0) :
    (∫ x in Ioi 0, (|p| * x ^ (p - 1)) • g (x ^ p)) = ∫ y in Ioi 0, g y :=
  by
  let S := Ioi (0 : ℝ)
  have a1 : ∀ x : ℝ, x ∈ S → HasDerivWithinAt (fun t : ℝ => t ^ p) (p * x ^ (p - 1)) S x :=
    fun x hx => (has_deriv_at_rpow_const (Or.inl (mem_Ioi.mp hx).ne')).HasDerivWithinAt
  have a2 : inj_on (fun x : ℝ => x ^ p) S :=
    by
    rcases lt_or_gt_of_ne hp with ⟨⟩
    · apply StrictAntiOn.injOn
      intro x hx y hy hxy
      rw [← inv_lt_inv (rpow_pos_of_pos hx p) (rpow_pos_of_pos hy p), ← rpow_neg (le_of_lt hx), ←
        rpow_neg (le_of_lt hy)]
      exact rpow_lt_rpow (le_of_lt hx) hxy (neg_pos.mpr h)
    exact StrictMonoOn.injOn fun x hx y hy hxy => rpow_lt_rpow (mem_Ioi.mp hx).le hxy h
  have a3 : (fun t : ℝ => t ^ p) '' S = S := by
    ext1
    rw [mem_image]
    constructor
    · rintro ⟨y, hy, rfl⟩
      exact rpow_pos_of_pos hy p
    · intro hx
      refine' ⟨x ^ (1 / p), rpow_pos_of_pos hx _, _⟩
      rw [← rpow_mul (le_of_lt hx), one_div_mul_cancel hp, rpow_one]
  have := integral_image_eq_integral_abs_deriv_smul measurableSet_Ioi a1 a2 g
  rw [a3] at this
  rw [this]
  refine' set_integral_congr measurableSet_Ioi _
  intro x hx
  dsimp only
  rw [abs_mul, abs_of_nonneg (rpow_nonneg_of_nonneg (le_of_lt hx) _)]
#align measure_theory.integral_comp_rpow_Ioi MeasureTheory.integral_comp_rpow_Ioi

theorem integral_comp_rpow_Ioi_of_pos {g : ℝ → E} {p : ℝ} (hp : 0 < p) :
    (∫ x in Ioi 0, (p * x ^ (p - 1)) • g (x ^ p)) = ∫ y in Ioi 0, g y :=
  by
  convert integral_comp_rpow_Ioi g hp.ne'
  funext; congr ; rw [abs_of_nonneg hp.le]
#align measure_theory.integral_comp_rpow_Ioi_of_pos MeasureTheory.integral_comp_rpow_Ioi_of_pos

end IoiChangeVariables

end MeasureTheory


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

Integer power operation on fields.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_with_zero.power
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

universes u_1 u_2 u

namespace Mathlib

@[simp] theorem ring_hom.map_fpow {K : Type u_1} {L : Type u_2} [division_ring K] [division_ring L]
    (f : K →+* L) (a : K) (n : ℤ) : coe_fn f (a ^ n) = coe_fn f a ^ n :=
  monoid_with_zero_hom.map_fpow (ring_hom.to_monoid_with_zero_hom f)

@[simp] theorem neg_fpow_bit0 {K : Type u_1} [division_ring K] (x : K) (n : ℤ) :
    (-x) ^ bit0 n = x ^ bit0 n :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((-x) ^ bit0 n = x ^ bit0 n)) (fpow_bit0' (-x) n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((-x * -x) ^ n = x ^ bit0 n)) (fpow_bit0' x n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl ((-x * -x) ^ n = (x * x) ^ n)) (neg_mul_neg x x)))
        (Eq.refl ((x * x) ^ n))))

@[simp] theorem neg_fpow_bit1 {K : Type u_1} [division_ring K] (x : K) (n : ℤ) :
    (-x) ^ bit1 n = -x ^ bit1 n :=
  sorry

theorem fpow_nonneg_of_nonneg {K : Type u} [linear_ordered_field K] {a : K} (ha : 0 ≤ a) (z : ℤ) :
    0 ≤ a ^ z :=
  int.cases_on z (fun (z : ℕ) => idRhs (0 ≤ a ^ z) (pow_nonneg ha z))
    fun (z : ℕ) => idRhs (0 ≤ (a ^ Nat.succ z⁻¹)) (iff.mpr inv_nonneg (pow_nonneg ha (Nat.succ z)))

theorem fpow_pos_of_pos {K : Type u} [linear_ordered_field K] {a : K} (ha : 0 < a) (z : ℤ) :
    0 < a ^ z :=
  int.cases_on z (fun (z : ℕ) => idRhs (0 < a ^ z) (pow_pos ha z))
    fun (z : ℕ) => idRhs (0 < (a ^ Nat.succ z⁻¹)) (iff.mpr inv_pos (pow_pos ha (Nat.succ z)))

theorem fpow_le_of_le {K : Type u} [linear_ordered_field K] {x : K} (hx : 1 ≤ x) {a : ℤ} {b : ℤ}
    (h : a ≤ b) : x ^ a ≤ x ^ b :=
  sorry

theorem pow_le_max_of_min_le {K : Type u} [linear_ordered_field K] {x : K} (hx : 1 ≤ x) {a : ℤ}
    {b : ℤ} {c : ℤ} (h : min a b ≤ c) : x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) :=
  sorry

theorem fpow_le_one_of_nonpos {K : Type u} [linear_ordered_field K] {p : K} (hp : 1 ≤ p) {z : ℤ}
    (hz : z ≤ 0) : p ^ z ≤ 1 :=
  sorry

theorem one_le_fpow_of_nonneg {K : Type u} [linear_ordered_field K] {p : K} (hp : 1 ≤ p) {z : ℤ}
    (hz : 0 ≤ z) : 1 ≤ p ^ z :=
  sorry

theorem one_lt_pow {K : Type u_1} [linear_ordered_semiring K] {p : K} (hp : 1 < p) {n : ℕ} :
    1 ≤ n → 1 < p ^ n :=
  sorry

theorem one_lt_fpow {K : Type u_1} [linear_ordered_field K] {p : K} (hp : 1 < p) (z : ℤ) :
    0 < z → 1 < p ^ z :=
  sorry

theorem nat.fpow_pos_of_pos {K : Type u_1} [linear_ordered_field K] {p : ℕ} (h : 0 < p) (n : ℤ) :
    0 < ↑p ^ n :=
  sorry

theorem nat.fpow_ne_zero_of_pos {K : Type u_1} [linear_ordered_field K] {p : ℕ} (h : 0 < p)
    (n : ℤ) : ↑p ^ n ≠ 0 :=
  ne_of_gt (nat.fpow_pos_of_pos h n)

theorem fpow_strict_mono {K : Type u_1} [linear_ordered_field K] {x : K} (hx : 1 < x) :
    strict_mono fun (n : ℤ) => x ^ n :=
  sorry

@[simp] theorem fpow_lt_iff_lt {K : Type u_1} [linear_ordered_field K] {x : K} (hx : 1 < x) {m : ℤ}
    {n : ℤ} : x ^ m < x ^ n ↔ m < n :=
  strict_mono.lt_iff_lt (fpow_strict_mono hx)

@[simp] theorem fpow_le_iff_le {K : Type u_1} [linear_ordered_field K] {x : K} (hx : 1 < x) {m : ℤ}
    {n : ℤ} : x ^ m ≤ x ^ n ↔ m ≤ n :=
  strict_mono.le_iff_le (fpow_strict_mono hx)

@[simp] theorem pos_div_pow_pos {K : Type u_1} [linear_ordered_field K] {a : K} {b : K} (ha : 0 < a)
    (hb : 0 < b) (k : ℕ) : 0 < a / b ^ k :=
  div_pos ha (pow_pos hb k)

@[simp] theorem div_pow_le {K : Type u_1} [linear_ordered_field K] {a : K} {b : K} (ha : 0 < a)
    (hb : 1 ≤ b) (k : ℕ) : a / b ^ k ≤ a :=
  iff.mpr (div_le_iff (pow_pos (lt_of_lt_of_le zero_lt_one hb) k))
    (trans_rel_right LessEq (Eq.symm (mul_one a))
      (iff.mpr (mul_le_mul_left ha) (one_le_pow_of_one_le hb k)))

theorem fpow_injective {K : Type u_1} [linear_ordered_field K] {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) :
    function.injective (pow x) :=
  sorry

@[simp] theorem fpow_inj {K : Type u_1} [linear_ordered_field K] {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1)
    {m : ℤ} {n : ℤ} : x ^ m = x ^ n ↔ m = n :=
  function.injective.eq_iff (fpow_injective h₀ h₁)

@[simp] theorem rat.cast_fpow {K : Type u_1} [field K] [char_zero K] (q : ℚ) (n : ℤ) :
    ↑(q ^ n) = ↑q ^ n :=
  ring_hom.map_fpow (rat.cast_hom K) q n

end Mathlib


/-
Copyright (c) 2021 Justus Springer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Justus Springer

! This file was ported from Lean 3 source module topology.sheaves.sheaf_condition.sites
! leanprover-community/mathlib commit d39590fc8728fbf6743249802486f8c91ffe07bc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Sites.Spaces
import Mathbin.Topology.Sheaves.Sheaf
import Mathbin.CategoryTheory.Sites.DenseSubsite

/-!

# Coverings and sieves; from sheaves on sites and sheaves on spaces

In this file, we connect coverings in a topological space to sieves in the associated Grothendieck
topology, in preparation of connecting the sheaf condition on sites to the various sheaf conditions
on spaces.

We also specialize results about sheaves on sites to sheaves on spaces; we show that the inclusion
functor from a topological basis to `topological_space.opens` is cover_dense, that open maps
induce cover_preserving functors, and that open embeddings induce compatible_preserving functors.

-/

noncomputable section

universe w v u

open CategoryTheory TopologicalSpace

namespace TopCat.Presheaf

variable {X : TopCat.{w}}

/-- Given a presieve `R` on `U`, we obtain a covering family of open sets in `X`, by taking as index
type the type of dependent pairs `(V, f)`, where `f : V ⟶ U` is in `R`.
-/
def coveringOfPresieve (U : Opens X) (R : Presieve U) : (ΣV, { f : V ⟶ U // R f }) → Opens X :=
  fun f => f.1
#align Top.presheaf.covering_of_presieve TopCat.Presheaf.coveringOfPresieve

@[simp]
theorem coveringOfPresieve_apply (U : Opens X) (R : Presieve U) (f : ΣV, { f : V ⟶ U // R f }) :
    coveringOfPresieve U R f = f.1 :=
  rfl
#align Top.presheaf.covering_of_presieve_apply TopCat.Presheaf.coveringOfPresieve_apply

namespace CoveringOfPresieve

variable (U : Opens X) (R : Presieve U)

/--
If `R` is a presieve in the grothendieck topology on `opens X`, the covering family associated to
`R` really is _covering_, i.e. the union of all open sets equals `U`.
-/
theorem supᵢ_eq_of_mem_grothendieck (hR : Sieve.generate R ∈ Opens.grothendieckTopology X U) :
    supᵢ (coveringOfPresieve U R) = U := by
  apply le_antisymm
  · refine' supᵢ_le _
    intro f
    exact f.2.1.le
  intro x hxU
  rw [opens.mem_supr]
  obtain ⟨V, iVU, ⟨W, iVW, iWU, hiWU, -⟩, hxV⟩ := hR x hxU
  exact ⟨⟨W, ⟨iWU, hiWU⟩⟩, iVW.le hxV⟩
#align Top.presheaf.covering_of_presieve.supr_eq_of_mem_grothendieck TopCat.Presheaf.coveringOfPresieve.supᵢ_eq_of_mem_grothendieck

end CoveringOfPresieve

/-- Given a family of opens `U : ι → opens X` and any open `Y : opens X`, we obtain a presieve
on `Y` by declaring that a morphism `f : V ⟶ Y` is a member of the presieve if and only if
there exists an index `i : ι` such that `V = U i`.
-/
def presieveOfCoveringAux {ι : Type v} (U : ι → Opens X) (Y : Opens X) : Presieve Y := fun V f =>
  ∃ i, V = U i
#align Top.presheaf.presieve_of_covering_aux TopCat.Presheaf.presieveOfCoveringAux

/-- Take `Y` to be `supr U` and obtain a presieve over `supr U`. -/
def presieveOfCovering {ι : Type v} (U : ι → Opens X) : Presieve (supᵢ U) :=
  presieveOfCoveringAux U (supᵢ U)
#align Top.presheaf.presieve_of_covering TopCat.Presheaf.presieveOfCovering

/-- Given a presieve `R` on `Y`, if we take its associated family of opens via
    `covering_of_presieve` (which may not cover `Y` if `R` is not covering), and take
    the presieve on `Y` associated to the family of opens via `presieve_of_covering_aux`,
    then we get back the original presieve `R`. -/
@[simp]
theorem covering_presieve_eq_self {Y : Opens X} (R : Presieve Y) :
    presieveOfCoveringAux (coveringOfPresieve Y R) Y = R :=
  by
  ext (Z f)
  exact ⟨fun ⟨⟨_, _, h⟩, rfl⟩ => by convert h, fun h => ⟨⟨Z, f, h⟩, rfl⟩⟩
#align Top.presheaf.covering_presieve_eq_self TopCat.Presheaf.covering_presieve_eq_self

namespace PresieveOfCovering

variable {ι : Type v} (U : ι → Opens X)

/-- The sieve generated by `presieve_of_covering U` is a member of the grothendieck topology.
-/
theorem mem_grothendieckTopology :
    Sieve.generate (presieveOfCovering U) ∈ Opens.grothendieckTopology X (supᵢ U) :=
  by
  intro x hx
  obtain ⟨i, hxi⟩ := opens.mem_supr.mp hx
  exact ⟨U i, opens.le_supr U i, ⟨U i, 𝟙 _, opens.le_supr U i, ⟨i, rfl⟩, category.id_comp _⟩, hxi⟩
#align Top.presheaf.presieve_of_covering.mem_grothendieck_topology TopCat.Presheaf.presieveOfCovering.mem_grothendieckTopology

/-- An index `i : ι` can be turned into a dependent pair `(V, f)`, where `V` is an open set and
`f : V ⟶ supr U` is a member of `presieve_of_covering U f`.
-/
def homOfIndex (i : ι) : ΣV, { f : V ⟶ supᵢ U // presieveOfCovering U f } :=
  ⟨U i, Opens.leSupr U i, i, rfl⟩
#align Top.presheaf.presieve_of_covering.hom_of_index TopCat.Presheaf.presieveOfCovering.homOfIndex

/-- By using the axiom of choice, a dependent pair `(V, f)` where `f : V ⟶ supr U` is a member of
`presieve_of_covering U f` can be turned into an index `i : ι`, such that `V = U i`.
-/
def indexOfHom (f : ΣV, { f : V ⟶ supᵢ U // presieveOfCovering U f }) : ι :=
  f.2.2.some
#align Top.presheaf.presieve_of_covering.index_of_hom TopCat.Presheaf.presieveOfCovering.indexOfHom

theorem indexOfHom_spec (f : ΣV, { f : V ⟶ supᵢ U // presieveOfCovering U f }) :
    f.1 = U (indexOfHom U f) :=
  f.2.2.choose_spec
#align Top.presheaf.presieve_of_covering.index_of_hom_spec TopCat.Presheaf.presieveOfCovering.indexOfHom_spec

end PresieveOfCovering

end TopCat.Presheaf

namespace TopCat.Opens

variable {X : TopCat} {ι : Type _}

theorem coverDense_iff_isBasis [Category ι] (B : ι ⥤ Opens X) :
    CoverDense (Opens.grothendieckTopology X) B ↔ Opens.IsBasis (Set.range B.obj) :=
  by
  rw [opens.is_basis_iff_nbhd]
  constructor; intro hd U x hx; rcases hd.1 U x hx with ⟨V, f, ⟨i, f₁, f₂, hc⟩, hV⟩
  exact ⟨B.obj i, ⟨i, rfl⟩, f₁.le hV, f₂.le⟩
  intro hb; constructor; intro U x hx; rcases hb hx with ⟨_, ⟨i, rfl⟩, hx, hi⟩
  exact ⟨B.obj i, ⟨⟨hi⟩⟩, ⟨⟨i, 𝟙 _, ⟨⟨hi⟩⟩, rfl⟩⟩, hx⟩
#align Top.opens.cover_dense_iff_is_basis TopCat.Opens.coverDense_iff_isBasis

theorem coverDense_inducedFunctor {B : ι → Opens X} (h : Opens.IsBasis (Set.range B)) :
    CoverDense (Opens.grothendieckTopology X) (inducedFunctor B) :=
  (coverDense_iff_isBasis _).2 h
#align Top.opens.cover_dense_induced_functor TopCat.Opens.coverDense_inducedFunctor

end TopCat.Opens

section OpenEmbedding

open TopCat.Presheaf Opposite

variable {C : Type u} [Category.{v} C]

variable {X Y : TopCat.{w}} {f : X ⟶ Y} {F : Y.Presheaf C}

theorem OpenEmbedding.compatiblePreserving (hf : OpenEmbedding f) :
    CompatiblePreserving (Opens.grothendieckTopology Y) hf.IsOpenMap.Functor :=
  by
  haveI : mono f := (TopCat.mono_iff_injective f).mpr hf.inj
  apply compatible_preserving_of_downwards_closed
  intro U V i
  refine'
    ⟨(opens.map f).obj V, eq_to_iso <| opens.ext <| Set.image_preimage_eq_of_subset fun x h => _⟩
  obtain ⟨_, _, rfl⟩ := i.le h
  exact ⟨_, rfl⟩
#align open_embedding.compatible_preserving OpenEmbedding.compatiblePreserving

theorem IsOpenMap.coverPreserving (hf : IsOpenMap f) :
    CoverPreserving (Opens.grothendieckTopology X) (Opens.grothendieckTopology Y) hf.Functor :=
  by
  constructor
  rintro U S hU _ ⟨x, hx, rfl⟩
  obtain ⟨V, i, hV, hxV⟩ := hU x hx
  exact ⟨_, hf.functor.map i, ⟨_, i, 𝟙 _, hV, rfl⟩, Set.mem_image_of_mem f hxV⟩
#align is_open_map.cover_preserving IsOpenMap.coverPreserving

theorem TopCat.Presheaf.isSheaf_of_openEmbedding (h : OpenEmbedding f) (hF : F.IsSheaf) :
    IsSheaf (h.IsOpenMap.Functor.op ⋙ F) :=
  pullback_isSheaf_of_coverPreserving h.CompatiblePreserving h.IsOpenMap.CoverPreserving ⟨_, hF⟩
#align Top.presheaf.is_sheaf_of_open_embedding TopCat.Presheaf.isSheaf_of_openEmbedding

end OpenEmbedding

namespace TopCat.Sheaf

open TopCat Opposite

variable {C : Type u} [Category.{v} C]

variable {X : TopCat.{w}} {ι : Type _} {B : ι → Opens X}

variable (F : X.Presheaf C) (F' : Sheaf C X) (h : Opens.IsBasis (Set.range B))

/-- The empty component of a sheaf is terminal -/
def isTerminalOfEmpty (F : Sheaf C X) : Limits.IsTerminal (F.val.obj (op ⊥)) :=
  F.isTerminalOfBotCover ⊥ (by tidy)
#align Top.sheaf.is_terminal_of_empty TopCat.Sheaf.isTerminalOfEmpty

/-- A variant of `is_terminal_of_empty` that is easier to `apply`. -/
def isTerminalOfEqEmpty (F : X.Sheaf C) {U : Opens X} (h : U = ⊥) :
    Limits.IsTerminal (F.val.obj (op U)) := by convert F.is_terminal_of_empty
#align Top.sheaf.is_terminal_of_eq_empty TopCat.Sheaf.isTerminalOfEqEmpty

/-- If a family `B` of open sets forms a basis of the topology on `X`, and if `F'`
    is a sheaf on `X`, then a homomorphism between a presheaf `F` on `X` and `F'`
    is equivalent to a homomorphism between their restrictions to the indexing type
    `ι` of `B`, with the induced category structure on `ι`. -/
def restrictHomEquivHom : ((inducedFunctor B).op ⋙ F ⟶ (inducedFunctor B).op ⋙ F'.1) ≃ (F ⟶ F'.1) :=
  @CoverDense.restrictHomEquivHom _ _ _ _ _ _ _ _ (Opens.coverDense_inducedFunctor h) _ F F'
#align Top.sheaf.restrict_hom_equiv_hom TopCat.Sheaf.restrictHomEquivHom

@[simp]
theorem extend_hom_app (α : (inducedFunctor B).op ⋙ F ⟶ (inducedFunctor B).op ⋙ F'.1) (i : ι) :
    (restrictHomEquivHom F F' h α).app (op (B i)) = α.app (op i) :=
  by
  nth_rw 2 [← (restrict_hom_equiv_hom F F' h).left_inv α]
  rfl
#align Top.sheaf.extend_hom_app TopCat.Sheaf.extend_hom_app

include h

theorem hom_ext {α β : F ⟶ F'.1} (he : ∀ i, α.app (op (B i)) = β.app (op (B i))) : α = β :=
  by
  apply (restrict_hom_equiv_hom F F' h).symm.Injective
  ext i
  exact he i.unop
#align Top.sheaf.hom_ext TopCat.Sheaf.hom_ext

end TopCat.Sheaf


import .atom

variables {α β : Type}

/-
Requires : qfree arg0
Ensures : nqfree ret
-/
def nnf (β) [@atom_type α β] : fm α → fm α
| (fm.true α) := ⊤'
| (fm.false α) := ⊥'
| (fm.atom a) := A' a
| (fm.not (fm.true α)) := ⊥'
| (fm.not (fm.false α)) := ⊤'
| (fm.not (fm.atom a)) := atom_type.neg β a
| (fm.not (fm.not p)) := nnf p
| (fm.not (fm.or p q)) := fm.and (nnf (¬' p)) (nnf (¬' q))
| (fm.not (fm.and p q)) := fm.or (nnf (¬' p)) (nnf (¬' q))
| (fm.not (fm.ex p)) := ⊥' -- Invalid input
| (fm.or p q) := fm.or (nnf p) (nnf q)
| (fm.and p q) := fm.and (nnf p) (nnf q)
| (fm.ex p) := ⊥' -- Invalid input

lemma nnf_exp_and [atom_type α β] (p q : fm α) :
@nnf α β _ (fm.and p q) = fm.and (@nnf α β _ p) (@nnf α β _ q) :=
by unfold nnf

lemma nnf_exp_or [atom_type α β] (p q : fm α) :
@nnf α β _ (p ∨' q) = (@nnf α β _ p ∨' @nnf α β _ q) := by unfold nnf

lemma nnf_exp_not_and [H : atom_type α β] (p q : fm α) :
@nnf α β _ (¬' (p ∧' q)) = (@nnf α β _ (¬' p) ∨' @nnf α β _ (¬' q)) :=
by unfold nnf

lemma nnf_exp_not_or [H : atom_type α β] (p q : fm α) :
@nnf α β _ (¬' (p ∨' q)) = (@nnf α β _ (¬' p) ∧' @nnf α β _ (¬' q)) :=
by unfold nnf

lemma nqfree_not_eq_nqfree [atom_type α β] : ∀ (p : fm α) (Hp : qfree p),
nqfree (@nnf α β _ (¬' p)) = nqfree (@nnf α β _  p) :=
λ p, fm.rec_on p
  (λ _, eq.refl _)
  (λ _, eq.refl _)
  (λ _ a, propext (iff.intro (λ _, trivial) (λ H, atom_type.neg_nqfree _ _)))
  (λ q r Hq Hr Hqr,
    begin
       unfold nnf, unfold nqfree,
        rw [Hq Hqr^.elim_left, Hr Hqr^.elim_right]
    end)
  (λ q r Hq Hr Hqr,
    begin
       unfold nnf, unfold nqfree,
        rw [Hq Hqr^.elim_left, Hr Hqr^.elim_right]
    end)
  (λ q Hq Hp, begin rewrite (Hq Hp), unfold nnf end)
  (λ _ _ Hp,
    begin
      unfold qfree at Hp,
      cases Hp
    end)

lemma nnf_nqfree [atom_type α β] :
  ∀ (p : fm α), qfree p → nqfree (@nnf α β _ p) :=
λ p, fm.rec_on p
(λ _, trivial)
(λ _, trivial)
(λ _ _, trivial)
(λ q r Hq Hr Hqr,
  begin
    rewrite nnf_exp_and, cases Hqr with hqr1 hqr2,
    apply (and.intro (Hq hqr1) (Hr hqr2))
  end)
(λ q r Hq Hr Hqr,
  begin
    rewrite nnf_exp_or, cases Hqr with hqr1 hqr2,
    apply (and.intro (Hq hqr1) (Hr hqr2))
  end)
(λ q, fm.rec_on q
  (λ _ _, trivial)
  (λ _ _, trivial)
  (λ _ _ _, by apply atom_type.neg_nqfree)
  (λ r s Hr Hs H1 H2,
    begin
      rewrite nnf_exp_not_and,
      rewrite nnf_exp_and at H1,
      apply (and.intro
              (Hr (λ _, (H1 H2)^.left) H2^.left)
              (Hs (λ _, (H1 H2)^.right) H2^.right)),
    end)
  (λ r s Hr Hs H1 H2,
    begin
      rewrite nnf_exp_not_or,
      rewrite nnf_exp_or at H1,
      apply (and.intro
              (Hr (λ _, (H1 H2)^.left) H2^.left)
              (Hs (λ _, (H1 H2)^.right) H2^.right)),
    end)
  (λ r Hr1 Hr2 Hr3,
    begin
      unfold nnf,
      rewrite nqfree_not_eq_nqfree at Hr2,
      apply (Hr2 Hr3), apply Hr3
    end
    )
  (λ _ _ _ Hr, by cases Hr))
(λ _ _ Hr, by cases Hr)

meta def nnf_prsv_lit : tactic unit :=
`[apply and.intro, refl, unfold nnf,
  unfold I, unfold interp, simp]

meta def nnf_prsv_normal_core_tac :=
  `[unfold nnf, unfold fnormal,
    unfold fnormal at hnm, cases hnm with hnmp hnmq,
    cases (@nnf_prsv_normal_core p hnmp) with ihp1 ihp2,
    cases (@nnf_prsv_normal_core q hnmq) with ihq1 ihq2,
    apply and.intro;  apply and.intro; assumption]

lemma nnf_prsv_normal_core [atom_type α β] :
  ∀ {p : fm α}, fnormal β p → fnormal β (nnf β p) ∧ fnormal β (nnf β ¬' p)
| (fm.true α) hnm := and.intro trivial trivial
| (fm.false α) hnm := and.intro trivial trivial
| (fm.atom a) hnm :=
  begin
    apply and.intro hnm,
    unfold nnf, rewrite fnormal_iff_fnormal_alt,
    apply atom_type.neg_prsv_normal, apply hnm
  end
| (fm.not p) hnm :=
  begin
    cases (@nnf_prsv_normal_core p _) with ih1 ih2,
    unfold nnf,apply and.intro; assumption, apply hnm
  end
| (fm.or p q) hnm := by nnf_prsv_normal_core_tac
| (fm.and p q) hnm := by nnf_prsv_normal_core_tac
| (fm.ex p) hnm :=
  begin unfold nnf, apply and.intro; trivial end

lemma nnf_prsv_normal [atom_type α β] {p : fm α} (h : fnormal β p) : fnormal β (nnf β p) :=
(nnf_prsv_normal_core h)^.elim_left

lemma nnf_prsv_core [atom_type α β] : ∀ (p : fm α), qfree p →
  (∀ (xs : list β), (I (@nnf α β _ p) xs ↔ I p xs) ∧ (I (@nnf α β _ ¬' p) xs ↔ I (¬' p) xs))
| (fm.true α)  Hp xs := by nnf_prsv_lit
| (fm.false α) Hp xs := by nnf_prsv_lit
| (fm.atom a)  Hp xs :=
  by {apply and.intro, refl,
      unfold nnf, apply atom_type.neg_prsv}
| (fm.and p q) Hp xs :=
  and.intro
    (begin
      unfold nnf, rewrite exp_I_and,
      rewrite (nnf_prsv_core p _ xs)^.elim_left,
      rewrite (nnf_prsv_core q _ xs)^.elim_left, refl,
      apply Hp^.elim_right, apply Hp^.elim_left
     end)
    (begin
      unfold nnf, rewrite exp_I_or,
      rewrite (nnf_prsv_core p _ xs)^.elim_right,
      rewrite (nnf_prsv_core q _ xs)^.elim_right,
      repeat {rewrite exp_I_not}, rewrite exp_I_and,
      apply iff_not_and,
      apply Hp^.elim_right, apply Hp^.elim_left
     end)
| (fm.or p q)  Hp xs :=
  and.intro
    (begin
      unfold nnf, rewrite exp_I_or,
      rewrite (nnf_prsv_core p _ xs)^.elim_left,
      rewrite (nnf_prsv_core q _ xs)^.elim_left, refl,
      apply Hp^.elim_right, apply Hp^.elim_left
     end)
    (begin
      unfold nnf, rewrite exp_I_and,
      rewrite (nnf_prsv_core p _ xs)^.elim_right,
      rewrite (nnf_prsv_core q _ xs)^.elim_right,
      repeat {rewrite exp_I_not}, rewrite exp_I_or,
      apply iff_not_or,
      apply Hp^.elim_right, apply Hp^.elim_left
     end)
| (fm.not p) Hp xs :=
  and.intro
    (nnf_prsv_core p Hp xs)^.elim_right
    (begin
      unfold nnf, repeat {rewrite exp_I_not},
      rewrite (nnf_prsv_core p Hp xs)^.elim_left,
      apply iff_not_not
     end)
| (fm.ex p) Hp xs := by cases Hp

lemma nnf_prsv [atom_type α β] (p : fm α) (Hp : qfree p) (xs : list β) :
I (@nnf α β _ p) xs ↔ I p xs := (nnf_prsv_core p Hp xs)^.elim_left


import .order .split_ifs

namespace rb
universes u v w
inductive col |Red|Black
inductive node (k : Type u) (α : Type v) : Type max u v
|Leaf {}: node
|Node (c:col) (l:node) (v:k×α) (r:node) : node
open node col
notation `Rd` := (Node Red)
notation `Bk` := (Node Black)

namespace node
variables {k : Type u} [has_lt k] [decidable_rel ((<) : k → k → Prop)]
variables {α : Type v}

def empty : node k α := Leaf
instance : has_emptyc (node k α) := ⟨empty⟩

def mk_black : node k α → node k α
|(Leaf) := Leaf
|(Node _ l a r) := Node Black l a r

def mk_red : node k α → node k α
|Leaf := Leaf
|(Node _ l a r) := Node Red l a r

@[simp] def lbal : node k α → k×α → node k α → node k α
| (Rd (Rd a x b) y c) v r := Rd (Bk a x b) y (Bk c v r)
| (Rd a x (Rd b y c)) v r := Rd (Bk a x b) y (Bk c v r)
| l v r := Bk l v r

variables (a b c r : node k α) (x y v : k×α)

def rbal : node k α → k×α → node k α → node k α
| l v (Rd (Rd b w c) z d) := Rd (Bk l v b) w (Bk c z d)
| l v (Rd b w (Rd c z d)) := Rd (Bk l v b) w (Bk c z d)
| l v r := Bk l v r

/--Same as `rbal` but cases swapped.-/
def rbal' : node k α → k×α → node k α → node k α
| l v (Rd b w (Rd c z d)) := Rd (Bk l v b) w (Bk c z d)
| l v (Rd (Rd b w c) z d) := Rd (Bk l v b) w (Bk c z d)
| l v r := Bk l v r

def lbalS : node k α → k×α → node k α → node k α
 | (Rd a x b) v r := Rd (Bk a x b) v r
 | l v (Bk a w b) := rbal' l v (Rd a w b)
 | l v (Rd (Bk a w b) z c) := Rd (Bk l v a) w (rbal' b z (mk_red c))
 | l v r := Rd l v r /- impossible -/

def rbalS : node k α → k×α → node k α → node k α
| l v (Rd b w c) := Rd l v (Bk b w c)
| (Bk a v b) w r := lbal (Rd a v b) w r
| (Rd a v₁ (Bk b v₂ c)) v₃ r := Rd (lbal (mk_red a) v₁ b) v₂ (Bk c v₃ r)
| l v r := Rd l v r /- impossible -/

def ins_aux (key : k) (a : α) : node k α → node k α
|Leaf := Rd Leaf ⟨key,a⟩ Leaf
|(Rd l v r) := -- l and r are both Black.
    if key < v.1 then Rd (ins_aux l) v r -- [FIXME] `Leaf` is `Black`, but `ins_aux Leaf` is `Red`, but (Red (Red)) is not wf.
    else if key > v.1 then Rd l v (ins_aux r) -- R
    else Rd l ⟨key,a⟩ r -- R
|(Bk l v r) :=
    if key < v.1 then lbal (ins_aux l) v r -- BR
    else if key > v.1 then rbal l v (ins_aux r) --BR
    else Bk l ⟨key,a⟩ r -- B

def insert : k → α → node k α → node k α :=
    λ key x s, mk_black (ins_aux key x s)
instance : has_insert (k×α) (node k α) := ⟨λ ⟨key,a⟩ t, insert key a t⟩

/--Used to get the `append` method to be well-founded-/
instance custom_wf : has_well_founded (node k α × node k α) :=
has_well_founded_of_has_sizeof (node k α × node k α)

def append : (node k α × node k α) → node k α
|⟨Leaf, r⟩ := r
|⟨ l,  Leaf⟩  := l
|⟨(Rd ll lx lr),(Rd rl rx rr) ⟩ :=
    match append ⟨lr, rl⟩ with
    |Rd lr x rl := Rd (Rd ll lx lr) x (Rd rl rx rr)
    |lrl := Rd ll lx (Rd lrl rx rr)
    end
|⟨ (Bk ll lx lr) ,(Bk rl rx rr) ⟩ :=
    match append ⟨lr, rl⟩ with
    |Rd lr x rl := Rd (Bk ll lx lr) x (Bk rl rx rr)
    |lrl := lbalS ll lx (Bk lrl rx rr)
    end
|⟨(Rd ll lx lr), r⟩ :=  Rd ll lx (append ⟨lr, r⟩)
|⟨ l, (Rd rl rx rr)⟩ := Rd (append ⟨l, rl⟩) rx rr

def erase_aux (key : k) : node k α → node k α
|Leaf := Leaf
|(Node _ l y r) :=
    if key < y.1 then
        match l with
        | (Bk _ _ _) := lbalS (erase_aux l) y r
        | _ := Rd (erase_aux l) y r
        end
    else if key > y.1 then
        match r with
        | (Bk _ _ _) := rbalS l y (erase_aux r)
        | _ := Rd l y (erase_aux r)
        end
    else append ⟨l, r⟩

def erase (key : k) (t : node k α) : node k α :=
mk_black (erase_aux key t)

def pop_min_aux : node k α → k×α → node k α → k × α × node k α
|Leaf ⟨k,x⟩ r := ⟨k,x,r⟩
|(Node lc ll lx lr) y r :=
    let ⟨k,x,l⟩ := pop_min_aux ll lx lr in
    match lc with
    |Black := ⟨k,x, lbalS l y r⟩
    |Red := ⟨k,x, Rd l y r⟩
    end

/-- Remove the minimal element and key from the table. -/
def pop_min : node k α → option (k × α × node k α)
|Leaf := none
|(Node _ l y r) :=
    let ⟨k,x,t⟩ := pop_min_aux l y r in
    some ⟨k,x, mk_black t⟩

def fold {β : Type w} (f : k → α → β → β) : β → node k α → β
|b Leaf := b
|b (Node _ l ⟨k,a⟩ r) := fold (f k a $ fold b l) r

def mfold {T : Type u → Type u} [monad T] {β}
  (f : k → α → β → T β) : β → node k α → T β
|b Leaf := pure b
|b (Node _ l ⟨k,a⟩ r) := do
    b ← mfold b l,
    b ← f k a b,
    mfold b r
/-- Get the number of black nodes between the root and the leaves of the trees. -/
def height : node k α → ℕ
|Leaf := 0
|(Rd l _ _ ) := height l
|(Bk l _ _ ) := nat.succ $ height l

namespace treeify
    def bogus : node k α × list (k×α) := ⟨Leaf, []⟩
    def treeify_t (k : Type u) (α : Type v) : Type max u v := list (k×α) → (node k α × list (k×α))
    def treeify_zero : treeify_t k α := λ acc, ⟨Leaf, acc⟩
    def treeify_one : treeify_t k α
    |(x::acc) := ⟨Rd Leaf x Leaf, acc⟩
    |_ := bogus
    def treeify_cont (f g : treeify_t k α) : treeify_t k α :=
    λ acc, match f acc with
    |⟨l, x::acc⟩ := let ⟨r, acc⟩ := g acc in ⟨Bk l x r, acc⟩
    |_ := bogus
    end
    def positive := list bool
    def treeify_aux : bool → positive → treeify_t k α
    |pred [] := if pred then treeify_zero else treeify_one
    |pred (ff::n) := treeify_cont (treeify_aux pred n) (treeify_aux tt n)
    |pred (tt::n) := treeify_cont (treeify_aux ff n) (treeify_aux pred n)
    def succ : positive → positive
    |[] := [ff]
    |(ff::tail) := tt::tail
    |(tt::tail) := ff :: (succ tail)
    def plength_aux : list α → positive → positive
    |[] p := p
    |(_::t) p := plength_aux t $ succ p
    def plength (l : list α) := plength_aux l []
end treeify
/--Take an __ordered__ list and convert it to a node tree.-/
def treeify (l : list (k×α)) : node k α :=
prod.fst $ treeify.treeify_aux tt (treeify.plength l) l

def filter (p : k → α → bool) : node k α → node k α :=
treeify ∘ fold (λ key a l, ite (p key a) (⟨key,a⟩::l) l) []

def get (key:k) : node k α → option α
|Leaf := none
|(Node _ l y r) :=
    if key < y.1 then get l else
    if y.1 < key then get r else
    some (y.2)

def contains (key:k): node k α → bool
:= option.is_some ∘ get key

instance : has_mem (k) (node k α) := ⟨λ key t, contains key t⟩

def min : node k α → option (k×α)
|Leaf := none
|(Node _ l x _) := (min l) <|> some x
def max : node k α → option (k× α )
|Leaf := none
|(Node _ _ x r) := (max r) <|> some x

/-- Asssign each member of `r` to `l`, if there is a key clash then choose the entry in `r` and clobber `l`. -/
def merge  : node k α → node k α → node k α := fold insert

def table (k : Type u) : Type u := node k unit

def intersect (t₁ t₂ : table k) : table k :=
    if height t₁ < height t₂
    then filter (λ k _, contains k t₂) t₁
    else filter (λ k _, contains k t₁) t₂
instance : has_inter (table k) := ⟨intersect⟩

def union (l r : table k) : table k :=
    if height l < height r
    then fold insert r l
    else fold insert l r
instance : has_union (table k) := ⟨union⟩

/--Remove all of the keys found in the table `r` from the dictionary `l`. -/
def subtract (l : node k α) (r : table k) : node k α := fold (λ k _ l, erase k l) l r
--instance : has_sub (table k) := ⟨subtract⟩

def map {β : Type w} (f : α → β) : node k α → node k β
|Leaf := Leaf
|(Node c l ⟨k,a⟩ r) := Node c (map l) ⟨k, f a⟩ (map r)
instance : functor (node k) :=
{ map := λ _ _ f t, map f t
}
def keys_of : (node k α) → table k := map (λ a, ⟨⟩)
end node

namespace proofs
open nat node
variables {k : Type u} {α : Type v}
variables [decidable_linear_order k]
inductive is_rb : node k α → col → nat → Prop
|leaf_rb {} : is_rb Leaf Black 0
|red_rb {l v r n} (rb_l : is_rb l Black n) (rb_r : is_rb r Black n) : is_rb (Rd l v r) Red n
|black_rb {l c₁ v r c₂ n} (rb_l : is_rb l c₁ n) (rb_r : is_rb r c₂ n) : is_rb(Bk l v r) Black (succ n)

inductive mem (key:k) : node k α → Prop
|left {c l v r} : mem l → mem (Node c l v r)
|mid {c l v r} : (v:k×α).1 = key → mem (Node c l v r)
|right {c l v r} : mem r → mem (Node c l v r)
instance : has_mem (k) (node k α) := ⟨mem⟩
lemma leaf_empty {key : k} : key ∉ (@Leaf k α) := λ h, by cases h

def dominates (k₁ : k) (t : node k α) : Prop
:= ∀ k₂ ∈ t, k₁ > k₂
def dominated_by (k₁ : k) (t : node k α) : Prop
:= ∀ k₂ ∈ t, k₁ < k₂
infix ` ⋗ `: 50 := dominates
infix ` ⋖ `: 50 := dominated_by

inductive ordered : node k α → Prop
|o_leaf {} : ordered (Leaf)
|o_node {c l} {v:k×α} {r} (ol:ordered l) (vdl :  v.1 ⋗ l) (rdv : v.1 ⋖ r) (or : ordered r) : ordered (Node c l v r)
lemma ordered.ol {c l v r} : ordered (Node c l v r : node k α) → ordered l := begin intros, cases a, assumption end
lemma ordered.or {c l v r} : ordered (Node c l v r : node k α) → ordered r := begin intros, cases a, assumption end
open ordered
@[simp] def is_wf (t: node k α) :  Prop := (∃ n, is_rb t Black n) ∧ ordered t

variables {key k₁ k₂ :k} {a:α} {v v₁ v₂ : k × α} {l r t : node k α} {c : col}

@[trans] lemma dominates.trans : k₁ > k₂ → k₂ ⋗ t → k₁ ⋗ t
:= λ p q k₃ kt, lt.trans (q _ kt) p
lemma dominates.leaf : k₁ ⋗ (@Leaf k α) := λ k₂ kt, false.rec_on _ $ leaf_empty kt
lemma dominates.node (hl : k₁ ⋗ l) (hv : k₁ > v.1) (hr : k₁ ⋗ r) : k₁ ⋗ (Node c l v r)
|k₂ (mem.left xl) := hl _ xl
|k₂ (mem.mid xm) := xm ▸ hv
|k₂ (mem.right xr) := hr _ xr
lemma dominates.l : k₁ ⋗ (Node c l v r) → k₁ ⋗ l := λ h k₂ hl, h k₂ (mem.left hl)
lemma dominates.r : k₁ ⋗ (Node c l v r) → k₁ ⋗ r := λ h k₂ hr, h k₂ (mem.right hr)
lemma dominates.v : k₁ ⋗ (Node c l v r) → k₁ > v.1 := λ h, h v.1 $ mem.mid rfl
@[trans] lemma dominated_by.trans : k₁ < k₂ → k₂ ⋖ t → k₁ ⋖ t
:= λ p q k₃ kt, lt.trans p (q _ kt)
lemma dominated_by.leaf : k₁ ⋖ (@Leaf k α) := λ k₂ kt, false.rec_on _ $ leaf_empty kt
lemma dominated_by.node (hl : k₁ ⋖ l) (hv : k₁ < v.1) (hr : k₁ ⋖ r) : k₁ ⋖ (Node c l v r)
|k₂ (mem.left xl) := hl _ xl
|k₂ (mem.mid xm) := xm ▸ hv
|k₂ (mem.right xr) := hr _ xr
lemma dominated_by.l : k₁ ⋖ (Node c l v r) → k₁ ⋖ l := λ h k₂ hl, h k₂ (mem.left hl)
lemma dominated_by.r : k₁ ⋖ (Node c l v r) → k₁ ⋖ r := λ h k₂ hr, h k₂ (mem.right hr)
lemma dominated_by.v : k₁ ⋖ (Node c l v r) → k₁ < v.1 := λ h, h v.1 $ mem.mid rfl

def all_below := λ (t₁ t₂ : node k α), ∀ (k₁ ∈ t₁) (k₂ ∈ t₂), k₁ < k₂
infix ` ⊏ `: 100 := all_below

open tactic

/- Look at the target, find all occurences of the name,  -/

meta def expand (n : name) : tactic unit :=
do delta_target [n]

meta def get_cases_candidate_single (e : expr) : tactic expr :=
do
    --e ← tactic.to_expr pe,
    s_l ← get_simp_lemmas_or_default none,
    e ← simp_lemmas.dsimplify s_l [`rec_on, `cases_on] e {fail_if_unchanged := ff}, -- rewrite alternative definitions of recursion.
    --e ← whnf e,
    (fn,args) ← pure $ expr.get_app_fn_args e,
    fn_name ← pure $ expr.const_name fn,
    env ← get_env,
    is_rec ← pure $ environment.is_recursor env fn_name,
    -- hopefully, the last argument of the recursor is always the thing being recursed on.
    rec_arg ← pure $ expr.app_arg e,
    is_local ← pure $ expr.is_local_constant rec_arg,
    -- trace fn_name,
    -- trace args,
    -- trace is_rec,
    -- trace rec_arg,
    -- trace is_local,
    -- trace "\n",
    guard is_rec,
    guard is_local,
    pure rec_arg

meta def get_cases_candidate : expr → tactic expr := λ e,
get_cases_candidate_single e <|> list.any_of (expr.get_app_args e) get_cases_candidate

meta def recursion_cases : tactic unit :=
do
     t ← target >>= instantiate_mvars,
     cand ← get_cases_candidate t,
     --trace cand,
     tactic.cases_core cand,
     --dsimp_target none [] {fail_if_unchanged := ff},
     all_goals $ try $ dsimp_target,
     --(dsimp_target none []) <|> pure ⟨⟩,
    --  args ← pure $ expr.get_app_args e,
    --  list.any_of args cases_on_variable
    --tactic.dsimplify (λ e, pure ⟨e,tt⟩) (dsimp_post) t,
    pure ⟨⟩

#check node.cases_on
#check node.rec_on

meta def cases_all : expr → tactic (list expr) := λ h,
do
    --h ← get_local h_name,
    --trace h,
    ty ← infer_type h >>= instantiate_mvars >>= whnf,
    --trace ty,
    --[c] ← get_constructors_for ty | pure [],
    -- count the number of non-named arguments
    [(case_name,new_hyps,new_subs)] ← cases_core h | fail "more than one constructor",
    list.mfoldl (λ l h, list.append l <$> ((cases_all h) <|> (pure [h]))) [] new_hyps

meta def one_of : list (tactic unit) → tactic unit
|(h::t) := h <|> one_of t
|[] := skip

meta def apply_pexpr : pexpr → tactic unit :=
λ p, ((to_expr p) >>= apply) $> ⟨⟩

inductive growth : node k α → nat → Prop
|stay {c n t} : is_rb t c n → growth t n
|sprout_l {n l v r} : is_rb l Red n → is_rb r Black n → growth (Rd l v r) n
|sprout_r {n l v r} : is_rb l Black n → is_rb r Red n → growth (Rd l v r) n
/- We have to consider way more cases than the written definition
    of `rbal` because the equation compiler has to transform the match expression into a series of
    `cases_on` calls which is less flexible than match.
    As far as I can tell these are the solutions to avoiding having to do all of the cases
    - Write a `rbal_ind` helper lemma: like below.
    - Write some really clever automation that reduces the problem to a few cases for you.
    - Write your proofs inline with the function -
        this tends to obfuscate what your underlying data transformation is
        and makes everything quite bloaty. It is very hard to pull off.
        -/
lemma rbal_ind {P Q : node k α → Prop} {q : Q r}
    (c₁ : Π  {b c d w z}, Q(Rd (Rd b w c) z d) → P(Rd (Bk l v b) w (Bk c z d)))
    (c₂ : Π  {b c d w z}, Q(Rd b w (Rd c z d)) → P(Rd (Bk l v b) w (Bk c z d)))
    (c₃ : P(Bk l v r))
    : P(rbal l v r)
    :=
    begin
        expand ``rbal, dsimp_target none [`id_rhs],
        repeat{one_of [
            recursion_cases,
            apply_pexpr ```(c₁ q),
            apply_pexpr ```(c₂ q),
            apply_pexpr ```(c₃)
        ]},
    end

-- lemma ins_aux_ind {P Q : node k α → Prop} (q : Q t)
--     (c₁ : P(Rd Leaf ⟨key,a⟩ Leaf))
--     (c₂ : Π {l v r}, Q(Bk l v r) → key < v.1 → P(ins_aux key a l) → P(lbal (ins_aux key a l) v r))
--     (c₃ : Π {l v r}, Q(Bk l v r) → key > v.1 → P(ins_aux key a r) → P(rbal l v (ins_aux key a r)))
--     (c₄ : Π {l v r}, Q(Bk l v r) → key = v.1 → P(Bk l ⟨key,a⟩ r))
--     (c₅ : Π {l v r}, Q(Rd l v r) → key < v.1 → P(ins_aux key a l) → P(Rd (ins_aux key a l) v r))
--     (c₆ : Π {l v r}, Q(Rd l v r) → key > v.1 → P(ins_aux key a r) → P(Rd l v (ins_aux key a r)))
--     (c₇ : Π {l v r}, Q(Rd l v r) → key = v.1 → P(Rd l ⟨key,a⟩ r))
--     : P(ins_aux key a t) :=
-- begin
--   induction t with c l v r, apply c₁, cases c,
--   simp [ins_aux],
--   --expand ``ins_aux, simp, dsimp_target none [`id_rhs],
--   focus {
--       split_ifs, apply c₅ _ _ (t_ih_l _), repeat {assumption},
--   }

-- end

lemma rbal.ordered (ol : ordered l) (vdl : v.1 ⋗ l) (rdv : v.1 ⋖ r) (or : ordered r) : ordered (rbal l v r) :=
begin
   apply rbal_ind, apply and.intro or rdv,
   focus {
        intros _ _ _ _ _ a, (get_local `a >>= cases_all), apply o_node (o_node _ _ _ _) _ _ (o_node _ _ _ _), repeat {assumption},
        apply a_right.l.l,
        apply dominates.node, apply dominates.trans, apply a_right.l.v, assumption, apply a_right.l.v, assumption,
        apply dominated_by.node, assumption, apply a_left_vdl.v, apply dominated_by.trans, apply a_left_vdl.v, assumption, apply a_left_vdl.r
      },
    focus {
        intros _ _ _ _ _ a, (get_local `a >>= cases_all), apply o_node (o_node _ _ _ _) _ _ (o_node _ _ _ _), repeat {assumption},
        apply a_right.l,
        apply dominates.node, apply dominates.trans, apply a_right.v, assumption, apply a_right.v, assumption,
        apply dominated_by.node, apply a_left_rdv.l, apply a_left_rdv.v, apply dominated_by.trans, apply a_left_rdv.v, assumption
    },
    focus {
        apply o_node ol vdl rdv or,
    }
end

lemma rbal_mem : (key ∈ r) → (key ∈ rbal l v r) := begin
    intros,
    apply rbal_ind, apply a, focus {intros _ _ _ _ _ h, cases h, cases h_a,
        apply (mem.left $ mem.right _),assumption,
        apply (mem.mid _), assumption,
        apply (mem.right $ mem.left _), assumption,
        apply (mem.right $ mem.mid _), assumption,
        apply (mem.right $ mem.right _), assumption,
    },
    focus {intros, cases a_1,
        apply (mem.left $ mem.right _), assumption,
    apply (mem.mid _), assumption,
    cases a_1_a,
    apply (mem.right $ mem.left _), assumption,
    apply (mem.right $ mem.mid _), assumption,
    apply (mem.right $ mem.right _), assumption,
     },
    focus {
        apply mem.right, assumption,
    }
end

lemma rbal_rb {cl n} : is_rb l cl n → growth r n → ∃ c', is_rb (rbal l v r) c' (succ n) :=
begin
    intros lrb rrg,
    apply @rbal_ind k _ _ _ _ _  (λ t, ∃ c', is_rb (t) c' (succ n)) (λ t, growth t n), apply rrg,
    focus {intros, cases a, cases a_a, cases a_a_rb_l, split, apply is_rb.red_rb, apply is_rb.black_rb, assumption, cases a_a, assumption, apply is_rb.black_rb,    },
    focus {intros, cases a, cases a_rb_r, },
    focus {existsi Black, apply is_rb.black_rb, assumption, assumption}
end

-- [TODO] repeat for lbal.

lemma eq_of_nlt {a b : k} : (¬ a < b) → ¬(b < a) → a = b := λ p q,
match lt_trichotomy a b with
|(or.inl h) := absurd h p
|(or.inr (or.inl h)) := h
|(or.inr (or.inr h)) := absurd h q
end

lemma lbal.ordered : ordered l → v.1 ⋗ l → v.1 ⋖ r → ordered r → ordered (lbal l v r) := sorry
lemma lbal.mem : (key ∈ l) → (key ∈ lbal l v r) := sorry
lemma lbal.rb {cl cr n} : is_rb l cl n → is_rb r cr n → ∃ c', is_rb (lbal l v r) c' (succ n) := sorry
lemma ins_aux.mem : (k₁ ∈ ins_aux key a t) ↔ (k₁ ∈ t ∨ k₁ = key) := sorry
lemma ins_aux.is_rb {n} : is_rb t c n → ∃ c', is_rb (ins_aux key a t) c' n :=
begin
    intro rb,
    induction rb with l v r n hl hr il ir l c₁ v r c₂ n hl hr il ir,
    case rb.proofs.is_rb.leaf_rb {
        simp [ins_aux], split,
        apply is_rb.red_rb, all_goals {apply is_rb.leaf_rb},
    },
    case rb.proofs.is_rb.red_rb {
        simp [ins_aux], split_ifs,
        split, apply is_rb.red_rb,
    }
end
lemma ins_aux.ordered :  ordered t → ordered (ins_aux key a t) :=
begin
    intro o,
    induction t with c l v r lq rq,
    case rb.node.Leaf {
        simp [ins_aux], apply o_node, assumption, apply dominates.leaf, apply dominated_by.leaf, assumption,
    },
    case rb.node.Node {
        cases o,
        have hl := lq o_ol, clear lq,
        have hr := rq o_or, clear rq,
        cases c,
        all_goals {simp[ins_aux] },
        case rb.col.Red {
            split_ifs,
            apply o_node,
            any_goals {assumption},
            focus {
                intros k₁ ki,
                have h₂ := ins_aux.mem.1 ki, cases h₂,
                apply o_vdl, assumption,
                cases h₂, assumption,
            },
            split_ifs, focus {
                apply o_node, any_goals {assumption}, intros k₁ ki,
                cases (ins_aux.mem.1 ki),
                apply o_rdv, assumption,
                cases h_2, assumption
            },
            split_ifs,
            have e := eq_of_nlt h h_1, subst e,
            apply o_node, any_goals {assumption}
        },
        case rb.col.Black {
            split_ifs, apply lbal.ordered, any_goals {assumption},
            intros k₁ ki,  cases (ins_aux.mem.1 ki),
            apply o_vdl _ h_1, subst h_1, assumption,
            split_ifs, apply rbal.ordered, any_goals {assumption},
            intros k₁ ki, cases (ins_aux.mem.1 ki),
            apply o_rdv _ h_2, subst h_2, assumption,
            split_ifs,
            have e := eq_of_nlt h h_1, subst e,
            apply o_node, any_goals {assumption}
        }
    }
end

/- Now that I have worked this out,
I am 100% sure that I can write some automation for this, probably in the same vain as auto2
 so I don't have to redesign anything.
   It will be some non-trivial amount of work.
 -/

lemma empty_is_wf : is_wf (@node.empty k _ _ α) := sorry

lemma insert_is_wf :is_wf t → is_wf (insert key a t) := sorry
lemma insert_works :  is_wf t → get key (insert key a t) = some a := sorry

lemma erase_is_wf : is_wf t → is_wf (erase key t) := sorry
lemma erase_works : is_wf t → get key (erase key t) = none := sorry

/- [TODO] from mathlib -/
inductive sorted (R : α → α → Prop) : list α → Prop
|nil {} : sorted []
|cons {a} {l:list α} : (∀ b∈l, R a b) → sorted l → sorted (a::l)
lemma treeify_works : ∀ {l : list (k×α)}, sorted ((<) on prod.fst) l → is_wf (treeify l) := sorry
lemma filter_works {p} : is_wf t → is_wf (filter p t) := sorry

end proofs
end rb


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.linear_map
import Mathlib.algebra.opposites
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Module operations on `Mᵒᵖ`

This file contains definitions that could not be placed into `algebra.opposites` due to import
cycles.
-/

namespace opposite

/-- `opposite.distrib_mul_action` extends to a `semimodule` -/
protected instance semimodule (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : semimodule R (Mᵒᵖ) :=
  semimodule.mk sorry sorry

/-- The function `op` is a linear equivalence. -/
def op_linear_equiv (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : linear_equiv R M (Mᵒᵖ) :=
  linear_equiv.mk (add_equiv.to_fun op_add_equiv) sorry sorry (add_equiv.inv_fun op_add_equiv) sorry sorry

@[simp] theorem coe_op_linear_equiv (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : ⇑(op_linear_equiv R) = op :=
  rfl

@[simp] theorem coe_op_linear_equiv_symm (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : ⇑(linear_equiv.symm (op_linear_equiv R)) = unop :=
  rfl

@[simp] theorem coe_op_linear_equiv_to_linear_map (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : ⇑(linear_equiv.to_linear_map (op_linear_equiv R)) = op :=
  rfl

@[simp] theorem coe_op_linear_equiv_symm_to_linear_map (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : ⇑(linear_equiv.to_linear_map (linear_equiv.symm (op_linear_equiv R))) = unop :=
  rfl

@[simp] theorem op_linear_equiv_to_add_equiv (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : linear_equiv.to_add_equiv (op_linear_equiv R) = op_add_equiv :=
  rfl

@[simp] theorem op_linear_equiv_symm_to_add_equiv (R : Type u) {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : linear_equiv.to_add_equiv (linear_equiv.symm (op_linear_equiv R)) = add_equiv.symm op_add_equiv :=
  rfl


/-
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, Bhavik Mehta
-/
import category_theory.monoidal.category
import category_theory.adjunction.basic

/-!
# (Lax) monoidal functors

A lax monoidal functor `F` between monoidal categories `C` and `D`
is a functor between the underlying categories equipped with morphisms
* `ε : 𝟙_ D ⟶ F.obj (𝟙_ C)` (called the unit morphism)
* `μ X Y : (F.obj X) ⊗ (F.obj Y) ⟶ F.obj (X ⊗ Y)` (called the tensorator, or strength).
satisfying various axioms.

A monoidal functor is a lax monoidal functor for which `ε` and `μ` are isomorphisms.

We show that the composition of (lax) monoidal functors gives a (lax) monoidal functor.

See also `category_theory.monoidal.functorial` for a typeclass decorating an object-level
function with the additional data of a monoidal functor.
This is useful when stating that a pre-existing functor is monoidal.

See `category_theory.monoidal.natural_transformation` for monoidal natural transformations.

We show in `category_theory.monoidal.Mon_` that lax monoidal functors take monoid objects
to monoid objects.

## Future work
* Oplax monoidal functors.

## References

See https://stacks.math.columbia.edu/tag/0FFL.
-/

open category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃

open category_theory.category
open category_theory.functor

namespace category_theory

section

open monoidal_category

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

/-- A lax monoidal functor is a functor `F : C ⥤ D` between monoidal categories,
equipped with morphisms `ε : 𝟙 _D ⟶ F.obj (𝟙_ C)` and `μ X Y : F.obj X ⊗ F.obj Y ⟶ F.obj (X ⊗ Y)`,
satisfying the appropriate coherences. -/
-- The direction of `left_unitality` and `right_unitality` as simp lemmas may look strange:
-- remember the rule of thumb that component indices of natural transformations
-- "weigh more" than structural maps.
-- (However by this argument `associativity` is currently stated backwards!)
structure lax_monoidal_functor extends C ⥤ D :=
-- unit morphism
(ε               : 𝟙_ D ⟶ obj (𝟙_ C))
-- tensorator
(μ                : Π X Y : C, (obj X) ⊗ (obj Y) ⟶ obj (X ⊗ Y))
(μ_natural'       : ∀ {X Y X' Y' : C}
  (f : X ⟶ Y) (g : X' ⟶ Y'),
  ((map f) ⊗ (map g)) ≫ μ Y Y' = μ X X' ≫ map (f ⊗ g)
  . obviously)
-- associativity of the tensorator
(associativity'   : ∀ (X Y Z : C),
    (μ X Y ⊗ 𝟙 (obj Z)) ≫ μ (X ⊗ Y) Z ≫ map (α_ X Y Z).hom
  = (α_ (obj X) (obj Y) (obj Z)).hom ≫ (𝟙 (obj X) ⊗ μ Y Z) ≫ μ X (Y ⊗ Z)
  . obviously)
-- unitality
(left_unitality'  : ∀ X : C,
    (λ_ (obj X)).hom
  = (ε ⊗ 𝟙 (obj X)) ≫ μ (𝟙_ C) X ≫ map (λ_ X).hom
  . obviously)
(right_unitality' : ∀ X : C,
    (ρ_ (obj X)).hom
  = (𝟙 (obj X) ⊗ ε) ≫ μ X (𝟙_ C) ≫ map (ρ_ X).hom
  . obviously)

restate_axiom lax_monoidal_functor.μ_natural'
attribute [simp, reassoc] lax_monoidal_functor.μ_natural
restate_axiom lax_monoidal_functor.left_unitality'
attribute [simp] lax_monoidal_functor.left_unitality
restate_axiom lax_monoidal_functor.right_unitality'
attribute [simp] lax_monoidal_functor.right_unitality
restate_axiom lax_monoidal_functor.associativity'
attribute [simp, reassoc] lax_monoidal_functor.associativity

-- When `rewrite_search` lands, add @[search] attributes to
-- lax_monoidal_functor.μ_natural lax_monoidal_functor.left_unitality
-- lax_monoidal_functor.right_unitality lax_monoidal_functor.associativity

section
variables {C D}

@[simp, reassoc]
lemma lax_monoidal_functor.left_unitality_inv (F : lax_monoidal_functor C D) (X : C) :
  (λ_ (F.obj X)).inv ≫ (F.ε ⊗ 𝟙 (F.obj X)) ≫ F.μ (𝟙_ C) X = F.map (λ_ X).inv :=
begin
  rw [iso.inv_comp_eq, F.left_unitality, category.assoc, category.assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

@[simp, reassoc]
lemma lax_monoidal_functor.right_unitality_inv (F : lax_monoidal_functor C D) (X : C) :
  (ρ_ (F.obj X)).inv ≫ (𝟙 (F.obj X) ⊗ F.ε) ≫ F.μ X (𝟙_ C) = F.map (ρ_ X).inv :=
begin
  rw [iso.inv_comp_eq, F.right_unitality, category.assoc, category.assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

@[simp, reassoc]
lemma lax_monoidal_functor.associativity_inv (F : lax_monoidal_functor C D) (X Y Z : C) :
  (𝟙 (F.obj X) ⊗ F.μ Y Z) ≫ F.μ X (Y ⊗ Z) ≫ F.map (α_ X Y Z).inv =
    (α_ (F.obj X) (F.obj Y) (F.obj Z)).inv ≫ (F.μ X Y ⊗ 𝟙 (F.obj Z)) ≫ F.μ (X ⊗ Y) Z :=
begin
  rw [iso.eq_inv_comp, ←F.associativity_assoc,
    ←F.to_functor.map_comp, iso.hom_inv_id, F.to_functor.map_id, comp_id],
end

end

/--
A monoidal functor is a lax monoidal functor for which the tensorator and unitor as isomorphisms.

See https://stacks.math.columbia.edu/tag/0FFL.
-/
structure monoidal_functor
extends lax_monoidal_functor.{v₁ v₂} C D :=
(ε_is_iso            : is_iso ε . tactic.apply_instance)
(μ_is_iso            : Π X Y : C, is_iso (μ X Y) . tactic.apply_instance)

attribute [instance] monoidal_functor.ε_is_iso monoidal_functor.μ_is_iso

variables {C D}

/--
The unit morphism of a (strong) monoidal functor as an isomorphism.
-/
noncomputable
def monoidal_functor.ε_iso (F : monoidal_functor.{v₁ v₂} C D) :
  tensor_unit D ≅ F.obj (tensor_unit C) :=
as_iso F.ε

/--
The tensorator of a (strong) monoidal functor as an isomorphism.
-/
noncomputable
def monoidal_functor.μ_iso (F : monoidal_functor.{v₁ v₂} C D) (X Y : C) :
  (F.obj X) ⊗ (F.obj Y) ≅ F.obj (X ⊗ Y) :=
as_iso (F.μ X Y)

end

open monoidal_category

namespace lax_monoidal_functor

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

/-- The identity lax monoidal functor. -/
@[simps] def id : lax_monoidal_functor.{v₁ v₁} C C :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. 𝟭 C }

instance : inhabited (lax_monoidal_functor C C) := ⟨id C⟩

end lax_monoidal_functor

namespace monoidal_functor

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

lemma map_tensor (F : monoidal_functor.{v₁ v₂} C D) {X Y X' Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') :
  F.map (f ⊗ g) = inv (F.μ X X') ≫ ((F.map f) ⊗ (F.map g)) ≫ F.μ Y Y' :=
by simp

lemma map_left_unitor (F : monoidal_functor.{v₁ v₂} C D) (X : C) :
  F.map (λ_ X).hom = inv (F.μ (𝟙_ C) X) ≫ (inv F.ε ⊗ 𝟙 (F.obj X)) ≫ (λ_ (F.obj X)).hom :=
begin
  simp only [lax_monoidal_functor.left_unitality],
  slice_rhs 2 3 { rw ←comp_tensor_id, simp, },
  simp,
end

lemma map_right_unitor (F : monoidal_functor.{v₁ v₂} C D) (X : C) :
  F.map (ρ_ X).hom = inv (F.μ X (𝟙_ C)) ≫ (𝟙 (F.obj X) ⊗ inv F.ε) ≫ (ρ_ (F.obj X)).hom :=
begin
  simp only [lax_monoidal_functor.right_unitality],
  slice_rhs 2 3 { rw ←id_tensor_comp, simp, },
  simp,
end

/-- The tensorator as a natural isomorphism. -/
noncomputable
def μ_nat_iso (F : monoidal_functor.{v₁ v₂} C D) :
  (functor.prod F.to_functor F.to_functor) ⋙ (tensor D) ≅ (tensor C) ⋙ F.to_functor :=
nat_iso.of_components
  (by { intros, apply F.μ_iso })
  (by { intros, apply F.to_lax_monoidal_functor.μ_natural })
end

section
variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C]

/-- The identity monoidal functor. -/
@[simps] def id : monoidal_functor.{v₁ v₁} C C :=
{ ε := 𝟙 _,
  μ := λ X Y, 𝟙 _,
  .. 𝟭 C }

instance : inhabited (monoidal_functor C C) := ⟨id C⟩

end

end monoidal_functor

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

namespace lax_monoidal_functor
variables (F : lax_monoidal_functor.{v₁ v₂} C D) (G : lax_monoidal_functor.{v₂ v₃} D E)

-- The proofs here are horrendous; rewrite_search helps a lot.
/-- The composition of two lax monoidal functors is again lax monoidal. -/
@[simps] def comp : lax_monoidal_functor.{v₁ v₃} C E :=
{ ε                := G.ε ≫ (G.map F.ε),
  μ                := λ X Y, G.μ (F.obj X) (F.obj Y) ≫ G.map (F.μ X Y),
  μ_natural'       := λ _ _ _ _ f g,
  begin
    simp only [functor.comp_map, assoc],
    rw [←category.assoc, lax_monoidal_functor.μ_natural, category.assoc, ←map_comp, ←map_comp,
        ←lax_monoidal_functor.μ_natural]
  end,
  associativity'   := λ X Y Z,
  begin
    dsimp,
    rw id_tensor_comp,
    slice_rhs 3 4 { rw [← G.to_functor.map_id, G.μ_natural], },
    slice_rhs 1 3 { rw ←G.associativity, },
    rw comp_tensor_id,
    slice_lhs 2 3 { rw [← G.to_functor.map_id, G.μ_natural], },
    rw [category.assoc, category.assoc, category.assoc, category.assoc, category.assoc,
        ←G.to_functor.map_comp, ←G.to_functor.map_comp, ←G.to_functor.map_comp,
        ←G.to_functor.map_comp, F.associativity],
  end,
  left_unitality'  := λ X,
  begin
    dsimp,
    rw [G.left_unitality, comp_tensor_id, category.assoc, category.assoc],
    apply congr_arg,
    rw [F.left_unitality, map_comp, ←nat_trans.id_app, ←category.assoc,
        ←lax_monoidal_functor.μ_natural, nat_trans.id_app, map_id, ←category.assoc, map_comp],
  end,
  right_unitality' := λ X,
  begin
    dsimp,
    rw [G.right_unitality, id_tensor_comp, category.assoc, category.assoc],
    apply congr_arg,
    rw [F.right_unitality, map_comp, ←nat_trans.id_app, ←category.assoc,
        ←lax_monoidal_functor.μ_natural, nat_trans.id_app, map_id, ←category.assoc, map_comp],
  end,
  .. (F.to_functor) ⋙ (G.to_functor) }.

infixr ` ⊗⋙ `:80 := comp

end lax_monoidal_functor

namespace monoidal_functor

variables (F : monoidal_functor.{v₁ v₂} C D) (G : monoidal_functor.{v₂ v₃} D E)

/-- The composition of two monoidal functors is again monoidal. -/
@[simps]
def comp : monoidal_functor.{v₁ v₃} C E :=
{ ε_is_iso := by { dsimp, apply_instance },
  μ_is_iso := by { dsimp, apply_instance },
  .. (F.to_lax_monoidal_functor).comp (G.to_lax_monoidal_functor) }.

infixr ` ⊗⋙ `:80 := comp -- We overload notation; potentially dangerous, but it seems to work.

end monoidal_functor

/--
If we have a right adjoint functor `G` to a monoidal functor `F`, then `G` has a lax monoidal
structure as well.
-/
@[simps]
noncomputable
def monoidal_adjoint (F : monoidal_functor C D) {G : D ⥤ C} (h : F.to_functor ⊣ G) :
  lax_monoidal_functor D C :=
{ to_functor := G,
  ε := h.hom_equiv _ _ (inv F.ε),
  μ := λ X Y,
    h.hom_equiv _ (X ⊗ Y) (inv (F.μ (G.obj X) (G.obj Y)) ≫ (h.counit.app X ⊗ h.counit.app Y)),
  μ_natural' := λ X Y X' Y' f g,
  begin
    rw [←h.hom_equiv_naturality_left, ←h.hom_equiv_naturality_right, equiv.apply_eq_iff_eq, assoc,
      is_iso.eq_inv_comp, ←F.to_lax_monoidal_functor.μ_natural_assoc, is_iso.hom_inv_id_assoc,
      ←tensor_comp, adjunction.counit_naturality, adjunction.counit_naturality, tensor_comp],
  end,
  associativity' := λ X Y Z,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←h.hom_equiv_naturality_left,
      ←h.hom_equiv_naturality_left, equiv.apply_eq_iff_eq,
      ← cancel_epi (F.to_lax_monoidal_functor.μ (G.obj X ⊗ G.obj Y) (G.obj Z)),
      ← cancel_epi (F.to_lax_monoidal_functor.μ (G.obj X) (G.obj Y) ⊗ 𝟙 (F.obj (G.obj Z))),
      F.to_lax_monoidal_functor.associativity_assoc (G.obj X) (G.obj Y) (G.obj Z),
      ←F.to_lax_monoidal_functor.μ_natural_assoc, assoc, is_iso.hom_inv_id_assoc,
      ←F.to_lax_monoidal_functor.μ_natural_assoc, is_iso.hom_inv_id_assoc, ←tensor_comp,
      ←tensor_comp, id_comp, functor.map_id, functor.map_id, id_comp, ←tensor_comp_assoc,
      ←tensor_comp_assoc, id_comp, id_comp, h.hom_equiv_unit, h.hom_equiv_unit, functor.map_comp,
      assoc, assoc, h.counit_naturality, h.left_triangle_components_assoc, is_iso.hom_inv_id_assoc,
      functor.map_comp, assoc, h.counit_naturality, h.left_triangle_components_assoc,
      is_iso.hom_inv_id_assoc],
    exact associator_naturality (h.counit.app X) (h.counit.app Y) (h.counit.app Z),
  end,
  left_unitality' := λ X,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←equiv.symm_apply_eq,
      h.hom_equiv_counit, F.map_left_unitor, h.hom_equiv_unit, assoc, assoc, assoc, F.map_tensor,
      assoc, assoc, is_iso.hom_inv_id_assoc, ←tensor_comp_assoc, functor.map_id, id_comp,
      functor.map_comp, assoc, h.counit_naturality, h.left_triangle_components_assoc,
      ←left_unitor_naturality, ←tensor_comp_assoc, id_comp, comp_id],
  end,
  right_unitality' := λ X,
  begin
    rw [←h.hom_equiv_naturality_right, ←h.hom_equiv_naturality_left, ←equiv.symm_apply_eq,
      h.hom_equiv_counit, F.map_right_unitor, assoc, assoc, ←right_unitor_naturality,
      ←tensor_comp_assoc, comp_id, id_comp, h.hom_equiv_unit, F.map_tensor, assoc, assoc, assoc,
      is_iso.hom_inv_id_assoc, functor.map_comp, functor.map_id, ←tensor_comp_assoc, assoc,
      h.counit_naturality, h.left_triangle_components_assoc, id_comp],
  end }.

/-- If a monoidal functor `F` is an equivalence of categories then its inverse is also monoidal. -/
noncomputable
def monoidal_inverse (F : monoidal_functor C D) [is_equivalence F.to_functor] :
  monoidal_functor D C :=
{ to_lax_monoidal_functor := monoidal_adjoint F (as_equivalence _).to_adjunction,
  ε_is_iso := by { dsimp [equivalence.to_adjunction], apply_instance },
  μ_is_iso := λ X Y, by { dsimp [equivalence.to_adjunction], apply_instance } }

@[simp]
lemma monoidal_inverse_to_functor (F : monoidal_functor C D) [is_equivalence F.to_functor] :
  (monoidal_inverse F).to_functor = F.to_functor.inv := rfl

end category_theory