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

! This file was ported from Lean 3 source module measure_theory.constructions.pi
! leanprover-community/mathlib commit 4b83fd2855cbf5e9da1fcf0fc1eba89a48c21551
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Constructions.Prod
import Mathbin.MeasureTheory.Group.Measure
import Mathbin.Topology.Constructions

/-!
# Product measures

In this file we define and prove properties about finite products of measures
(and at some point, countable products of measures).

## Main definition

* `measure_theory.measure.pi`: The product of finitely many σ-finite measures.
  Given `μ : Π i : ι, measure (α i)` for `[fintype ι]` it has type `measure (Π i : ι, α i)`.

To apply Fubini along some subset of the variables, use
`measure_theory.measure_preserving_pi_equiv_pi_subtype_prod` to reduce to the situation of a product
of two measures: this lemma states that the bijection
`measurable_equiv.pi_equiv_pi_subtype_prod α p` between `(Π i : ι, α i)` and
`(Π i : {i // p i}, α i) × (Π i : {i // ¬ p i}, α i)` maps a product measure to a direct product of
product measures, to which one can apply the usual Fubini for direct product of measures.

## Implementation Notes

We define `measure_theory.outer_measure.pi`, the product of finitely many outer measures, as the
maximal outer measure `n` with the property that `n (pi univ s) ≤ ∏ i, m i (s i)`,
where `pi univ s` is the product of the sets `{s i | i : ι}`.

We then show that this induces a product of measures, called `measure_theory.measure.pi`.
For a collection of σ-finite measures `μ` and a collection of measurable sets `s` we show that
`measure.pi μ (pi univ s) = ∏ i, m i (s i)`. To do this, we follow the following steps:
* We know that there is some ordering on `ι`, given by an element of `[countable ι]`.
* Using this, we have an equivalence `measurable_equiv.pi_measurable_equiv_tprod` between
  `Π ι, α i` and an iterated product of `α i`, called `list.tprod α l` for some list `l`.
* On this iterated product we can easily define a product measure `measure_theory.measure.tprod`
  by iterating `measure_theory.measure.prod`
* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for countable
  `ι`.
* We know that `measure_theory.measure.pi'` sends products of sets to products of measures, and
  since `measure_theory.measure.pi` is the maximal such measure (or at least, it comes from an outer
  measure which is the maximal such outer measure), we get the same rule for
  `measure_theory.measure.pi`.

## Tags

finitary product measure

-/

noncomputable section

open Function Set MeasureTheory.OuterMeasure Filter MeasurableSpace Encodable

open Classical BigOperators Topology ENNReal

universe u v

variable {ι ι' : Type _} {α : ι → Type _}

/-! We start with some measurability properties -/

/-- Boxes formed by π-systems form a π-system. -/
theorem IsPiSystem.pi {C : ∀ i, Set (Set (α i))} (hC : ∀ i, IsPiSystem (C i)) :
    IsPiSystem (pi univ '' pi univ C) :=
  by
  rintro _ ⟨s₁, hs₁, rfl⟩ _ ⟨s₂, hs₂, rfl⟩ hst
  rw [← pi_inter_distrib] at hst⊢; rw [univ_pi_nonempty_iff] at hst
  exact mem_image_of_mem _ fun i _ => hC i _ (hs₁ i (mem_univ i)) _ (hs₂ i (mem_univ i)) (hst i)
#align is_pi_system.pi IsPiSystem.pi

/-- Boxes form a π-system. -/
theorem isPiSystem_pi [∀ i, MeasurableSpace (α i)] :
    IsPiSystem (pi univ '' pi univ fun i => { s : Set (α i) | MeasurableSet s }) :=
  IsPiSystem.pi fun i => isPiSystem_measurableSet
#align is_pi_system_pi isPiSystem_pi

section Finite

variable [Finite ι] [Finite ι']

/-- Boxes of countably spanning sets are countably spanning. -/
theorem IsCountablySpanning.pi {C : ∀ i, Set (Set (α i))} (hC : ∀ i, IsCountablySpanning (C i)) :
    IsCountablySpanning (pi univ '' pi univ C) :=
  by
  choose s h1s h2s using hC
  cases nonempty_encodable (ι → ℕ)
  let e : ℕ → ι → ℕ := fun n => (decode (ι → ℕ) n).iget
  refine' ⟨fun n => pi univ fun i => s i (e n i), fun n => mem_image_of_mem _ fun i _ => h1s i _, _⟩
  simp_rw [(surjective_decode_iget (ι → ℕ)).unionᵢ_comp fun x => pi univ fun i => s i (x i),
    Union_univ_pi s, h2s, pi_univ]
#align is_countably_spanning.pi IsCountablySpanning.pi

/-- The product of generated σ-algebras is the one generated by boxes, if both generating sets
  are countably spanning. -/
theorem generateFrom_pi_eq {C : ∀ i, Set (Set (α i))} (hC : ∀ i, IsCountablySpanning (C i)) :
    (@MeasurableSpace.pi _ _ fun i => generateFrom (C i)) = generateFrom (pi univ '' pi univ C) :=
  by
  cases nonempty_encodable ι
  apply le_antisymm
  · refine' supᵢ_le _
    intro i
    rw [comap_generate_from]
    apply generate_from_le
    rintro _ ⟨s, hs, rfl⟩
    dsimp
    choose t h1t h2t using hC
    simp_rw [eval_preimage, ← h2t]
    rw [← @Union_const _ ℕ _ s]
    have :
      pi univ (update (fun i' : ι => Union (t i')) i (⋃ i' : ℕ, s)) =
        pi univ fun k => ⋃ j : ℕ, @update ι (fun i' => Set (α i')) _ (fun i' => t i' j) i s k :=
      by
      ext
      simp_rw [mem_univ_pi]
      apply forall_congr'
      intro i'
      by_cases i' = i
      · subst h
        simp
      · rw [← Ne.def] at h
        simp [h]
    rw [this, ← Union_univ_pi]
    apply MeasurableSet.unionᵢ
    intro n
    apply measurable_set_generate_from
    apply mem_image_of_mem
    intro j _
    dsimp only
    by_cases h : j = i
    subst h
    rwa [update_same]
    rw [update_noteq h]
    apply h1t
  · apply generate_from_le
    rintro _ ⟨s, hs, rfl⟩
    rw [univ_pi_eq_Inter]
    apply MeasurableSet.interᵢ
    intro i
    apply measurable_pi_apply
    exact measurable_set_generate_from (hs i (mem_univ i))
#align generate_from_pi_eq generateFrom_pi_eq

/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
  generate the σ-algebra on `α × β`. -/
theorem generateFrom_eq_pi [h : ∀ i, MeasurableSpace (α i)] {C : ∀ i, Set (Set (α i))}
    (hC : ∀ i, generateFrom (C i) = h i) (h2C : ∀ i, IsCountablySpanning (C i)) :
    generateFrom (pi univ '' pi univ C) = MeasurableSpace.pi := by
  rw [← funext hC, generateFrom_pi_eq h2C]
#align generate_from_eq_pi generateFrom_eq_pi

/-- The product σ-algebra is generated from boxes, i.e. `s ×ˢ t` for sets `s : set α` and
  `t : set β`. -/
theorem generateFrom_pi [∀ i, MeasurableSpace (α i)] :
    generateFrom (pi univ '' pi univ fun i => { s : Set (α i) | MeasurableSet s }) =
      MeasurableSpace.pi :=
  generateFrom_eq_pi (fun i => generateFrom_measurableSet) fun i =>
    isCountablySpanning_measurableSet
#align generate_from_pi generateFrom_pi

end Finite

namespace MeasureTheory

variable [Fintype ι] {m : ∀ i, OuterMeasure (α i)}

/-- An upper bound for the measure in a finite product space.
  It is defined to by taking the image of the set under all projections, and taking the product
  of the measures of these images.
  For measurable boxes it is equal to the correct measure. -/
@[simp]
def piPremeasure (m : ∀ i, OuterMeasure (α i)) (s : Set (∀ i, α i)) : ℝ≥0∞ :=
  ∏ i, m i (eval i '' s)
#align measure_theory.pi_premeasure MeasureTheory.piPremeasure

theorem piPremeasure_pi {s : ∀ i, Set (α i)} (hs : (pi univ s).Nonempty) :
    piPremeasure m (pi univ s) = ∏ i, m i (s i) := by simp [hs]
#align measure_theory.pi_premeasure_pi MeasureTheory.piPremeasure_pi

theorem piPremeasure_pi' {s : ∀ i, Set (α i)} : piPremeasure m (pi univ s) = ∏ i, m i (s i) :=
  by
  cases isEmpty_or_nonempty ι
  · simp
  cases' (pi univ s).eq_empty_or_nonempty with h h
  · rcases univ_pi_eq_empty_iff.mp h with ⟨i, hi⟩
    have : ∃ i, m i (s i) = 0 := ⟨i, by simp [hi]⟩
    simpa [h, Finset.card_univ, zero_pow (fintype.card_pos_iff.mpr ‹_›), @eq_comm _ (0 : ℝ≥0∞),
      Finset.prod_eq_zero_iff]
  · simp [h]
#align measure_theory.pi_premeasure_pi' MeasureTheory.piPremeasure_pi'

theorem piPremeasure_pi_mono {s t : Set (∀ i, α i)} (h : s ⊆ t) :
    piPremeasure m s ≤ piPremeasure m t :=
  Finset.prod_le_prod' fun i _ => (m i).mono' (image_subset _ h)
#align measure_theory.pi_premeasure_pi_mono MeasureTheory.piPremeasure_pi_mono

theorem piPremeasure_pi_eval {s : Set (∀ i, α i)} :
    piPremeasure m (pi univ fun i => eval i '' s) = piPremeasure m s := by simp [pi_premeasure_pi']
#align measure_theory.pi_premeasure_pi_eval MeasureTheory.piPremeasure_pi_eval

namespace OuterMeasure

/-- `outer_measure.pi m` is the finite product of the outer measures `{m i | i : ι}`.
  It is defined to be the maximal outer measure `n` with the property that
  `n (pi univ s) ≤ ∏ i, m i (s i)`, where `pi univ s` is the product of the sets
  `{s i | i : ι}`. -/
protected def pi (m : ∀ i, OuterMeasure (α i)) : OuterMeasure (∀ i, α i) :=
  boundedBy (piPremeasure m)
#align measure_theory.outer_measure.pi MeasureTheory.OuterMeasure.pi

theorem pi_pi_le (m : ∀ i, OuterMeasure (α i)) (s : ∀ i, Set (α i)) :
    OuterMeasure.pi m (pi univ s) ≤ ∏ i, m i (s i) :=
  by
  cases' (pi univ s).eq_empty_or_nonempty with h h
  simp [h]
  exact (bounded_by_le _).trans_eq (pi_premeasure_pi h)
#align measure_theory.outer_measure.pi_pi_le MeasureTheory.OuterMeasure.pi_pi_le

theorem le_pi {m : ∀ i, OuterMeasure (α i)} {n : OuterMeasure (∀ i, α i)} :
    n ≤ OuterMeasure.pi m ↔
      ∀ s : ∀ i, Set (α i), (pi univ s).Nonempty → n (pi univ s) ≤ ∏ i, m i (s i) :=
  by
  rw [outer_measure.pi, le_bounded_by']; constructor
  · intro h s hs
    refine' (h _ hs).trans_eq (pi_premeasure_pi hs)
  · intro h s hs
    refine' le_trans (n.mono <| subset_pi_eval_image univ s) (h _ _)
    simp [univ_pi_nonempty_iff, hs]
#align measure_theory.outer_measure.le_pi MeasureTheory.OuterMeasure.le_pi

end OuterMeasure

namespace Measure

variable [∀ i, MeasurableSpace (α i)] (μ : ∀ i, Measure (α i))

section Tprod

open List

variable {δ : Type _} {π : δ → Type _} [∀ x, MeasurableSpace (π x)]

-- for some reason the equation compiler doesn't like this definition
/-- A product of measures in `tprod α l`. -/
protected def tprod (l : List δ) (μ : ∀ i, Measure (π i)) : Measure (TProd π l) :=
  by
  induction' l with i l ih
  exact dirac PUnit.unit
  exact (μ i).Prod ih
#align measure_theory.measure.tprod MeasureTheory.Measure.tprod

@[simp]
theorem tProd_nil (μ : ∀ i, Measure (π i)) : Measure.tprod [] μ = dirac PUnit.unit :=
  rfl
#align measure_theory.measure.tprod_nil MeasureTheory.Measure.tProd_nil

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem tProd_cons (i : δ) (l : List δ) (μ : ∀ i, Measure (π i)) :
    Measure.tprod (i::l) μ = (μ i).Prod (Measure.tprod l μ) :=
  rfl
#align measure_theory.measure.tprod_cons MeasureTheory.Measure.tProd_cons

instance sigmaFiniteTprod (l : List δ) (μ : ∀ i, Measure (π i)) [∀ i, SigmaFinite (μ i)] :
    SigmaFinite (Measure.tprod l μ) :=
  by
  induction' l with i l ih
  · rw [tprod_nil]
    infer_instance
  · rw [tprod_cons]
    skip
    infer_instance
#align measure_theory.measure.sigma_finite_tprod MeasureTheory.Measure.sigmaFiniteTprod

theorem tProd_tProd (l : List δ) (μ : ∀ i, Measure (π i)) [∀ i, SigmaFinite (μ i)]
    (s : ∀ i, Set (π i)) : Measure.tprod l μ (Set.tprod l s) = (l.map fun i => (μ i) (s i)).Prod :=
  by
  induction' l with i l ih; · simp
  rw [tprod_cons, Set.tprod, prod_prod, map_cons, prod_cons, ih]
#align measure_theory.measure.tprod_tprod MeasureTheory.Measure.tProd_tProd

end Tprod

section Encodable

open List MeasurableEquiv

variable [Encodable ι]

/-- The product measure on an encodable finite type, defined by mapping `measure.tprod` along the
  equivalence `measurable_equiv.pi_measurable_equiv_tprod`.
  The definition `measure_theory.measure.pi` should be used instead of this one. -/
def pi' : Measure (∀ i, α i) :=
  Measure.map (TProd.elim' mem_sortedUniv) (Measure.tprod (sortedUniv ι) μ)
#align measure_theory.measure.pi' MeasureTheory.Measure.pi'

theorem pi'_pi [∀ i, SigmaFinite (μ i)] (s : ∀ i, Set (α i)) : pi' μ (pi univ s) = ∏ i, μ i (s i) :=
  by
  rw [pi', ← MeasurableEquiv.piMeasurableEquivTprod_symm_apply, MeasurableEquiv.map_apply,
      MeasurableEquiv.piMeasurableEquivTprod_symm_apply, elim_preimage_pi, tprod_tprod _ μ, ←
      List.prod_toFinset, sorted_univ_to_finset] <;>
    exact sorted_univ_nodup ι
#align measure_theory.measure.pi'_pi MeasureTheory.Measure.pi'_pi

end Encodable

theorem pi_caratheodory :
    MeasurableSpace.pi ≤ (OuterMeasure.pi fun i => (μ i).toOuterMeasure).caratheodory :=
  by
  refine' supᵢ_le _
  intro i s hs
  rw [MeasurableSpace.comap] at hs
  rcases hs with ⟨s, hs, rfl⟩
  apply bounded_by_caratheodory
  intro t
  simp_rw [pi_premeasure]
  refine' Finset.prod_add_prod_le' (Finset.mem_univ i) _ _ _
  · simp [image_inter_preimage, image_diff_preimage, measure_inter_add_diff _ hs, le_refl]
  · rintro j - hj
    apply mono'
    apply image_subset
    apply inter_subset_left
  · rintro j - hj
    apply mono'
    apply image_subset
    apply diff_subset
#align measure_theory.measure.pi_caratheodory MeasureTheory.Measure.pi_caratheodory

/-- `measure.pi μ` is the finite product of the measures `{μ i | i : ι}`.
  It is defined to be measure corresponding to `measure_theory.outer_measure.pi`. -/
protected irreducible_def pi : Measure (∀ i, α i) :=
  toMeasure (OuterMeasure.pi fun i => (μ i).toOuterMeasure) (pi_caratheodory μ)
#align measure_theory.measure.pi MeasureTheory.Measure.pi

theorem pi_pi_aux [∀ i, SigmaFinite (μ i)] (s : ∀ i, Set (α i)) (hs : ∀ i, MeasurableSet (s i)) :
    Measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
  by
  refine' le_antisymm _ _
  · rw [measure.pi, to_measure_apply _ _ (MeasurableSet.pi countable_univ fun i _ => hs i)]
    apply outer_measure.pi_pi_le
  · haveI : Encodable ι := Fintype.toEncodable ι
    rw [← pi'_pi μ s]
    simp_rw [← pi'_pi μ s, measure.pi,
      to_measure_apply _ _ (MeasurableSet.pi countable_univ fun i _ => hs i), ←
      to_outer_measure_apply]
    suffices (pi' μ).toOuterMeasure ≤ outer_measure.pi fun i => (μ i).toOuterMeasure by exact this _
    clear hs s
    rw [outer_measure.le_pi]
    intro s hs
    simp_rw [to_outer_measure_apply]
    exact (pi'_pi μ s).le
#align measure_theory.measure.pi_pi_aux MeasureTheory.Measure.pi_pi_aux

variable {μ}

/-- `measure.pi μ` has finite spanning sets in rectangles of finite spanning sets. -/
def FiniteSpanningSetsIn.pi {C : ∀ i, Set (Set (α i))}
    (hμ : ∀ i, (μ i).FiniteSpanningSetsIn (C i)) :
    (Measure.pi μ).FiniteSpanningSetsIn (pi univ '' pi univ C) :=
  by
  haveI := fun i => (hμ i).SigmaFinite
  haveI := Fintype.toEncodable ι
  refine'
      ⟨fun n => pi univ fun i => (hμ i).Set ((decode (ι → ℕ) n).iget i), fun n => _, fun n => _,
        _⟩ <;>-- TODO (kmill) If this let comes before the refine, while the noncomputability checker
    -- correctly sees this definition is computable, the Lean VM fails to see the binding is
    -- computationally irrelevant. The `noncomputable theory` doesn't help because all it does
    -- is insert `noncomputable` for you when necessary.
    let e : ℕ → ι → ℕ := fun n => (decode (ι → ℕ) n).iget
  · refine' mem_image_of_mem _ fun i _ => (hμ i).set_mem _
  ·
    calc
      measure.pi μ (pi univ fun i => (hμ i).Set (e n i)) ≤
          measure.pi μ (pi univ fun i => to_measurable (μ i) ((hμ i).Set (e n i))) :=
        measure_mono (pi_mono fun i hi => subset_to_measurable _ _)
      _ = ∏ i, μ i (to_measurable (μ i) ((hμ i).Set (e n i))) :=
        (pi_pi_aux μ _ fun i => measurable_set_to_measurable _ _)
      _ = ∏ i, μ i ((hμ i).Set (e n i)) := by simp only [measure_to_measurable]
      _ < ∞ := ENNReal.prod_lt_top fun i hi => ((hμ i).Finite _).Ne

  ·
    simp_rw [(surjective_decode_iget (ι → ℕ)).unionᵢ_comp fun x =>
        pi univ fun i => (hμ i).Set (x i),
      Union_univ_pi fun i => (hμ i).Set, (hμ _).spanning, Set.pi_univ]
#align measure_theory.measure.finite_spanning_sets_in.pi MeasureTheory.Measure.FiniteSpanningSetsIn.pi

/-- A measure on a finite product space equals the product measure if they are equal on rectangles
  with as sides sets that generate the corresponding σ-algebras. -/
theorem pi_eq_generateFrom {C : ∀ i, Set (Set (α i))}
    (hC : ∀ i, generateFrom (C i) = by apply_assumption) (h2C : ∀ i, IsPiSystem (C i))
    (h3C : ∀ i, (μ i).FiniteSpanningSetsIn (C i)) {μν : Measure (∀ i, α i)}
    (h₁ : ∀ s : ∀ i, Set (α i), (∀ i, s i ∈ C i) → μν (pi univ s) = ∏ i, μ i (s i)) :
    Measure.pi μ = μν :=
  by
  have h4C : ∀ (i) (s : Set (α i)), s ∈ C i → MeasurableSet s :=
    by
    intro i s hs
    rw [← hC]
    exact measurable_set_generate_from hs
  refine'
    (finite_spanning_sets_in.pi h3C).ext
      (generateFrom_eq_pi hC fun i => (h3C i).IsCountablySpanning).symm (IsPiSystem.pi h2C) _
  rintro _ ⟨s, hs, rfl⟩
  rw [mem_univ_pi] at hs
  haveI := fun i => (h3C i).SigmaFinite
  simp_rw [h₁ s hs, pi_pi_aux μ s fun i => h4C i _ (hs i)]
#align measure_theory.measure.pi_eq_generate_from MeasureTheory.Measure.pi_eq_generateFrom

variable [∀ i, SigmaFinite (μ i)]

/-- A measure on a finite product space equals the product measure if they are equal on
  rectangles. -/
theorem pi_eq {μ' : Measure (∀ i, α i)}
    (h : ∀ s : ∀ i, Set (α i), (∀ i, MeasurableSet (s i)) → μ' (pi univ s) = ∏ i, μ i (s i)) :
    Measure.pi μ = μ' :=
  pi_eq_generateFrom (fun i => generateFrom_measurableSet) (fun i => isPiSystem_measurableSet)
    (fun i => (μ i).toFiniteSpanningSetsIn) h
#align measure_theory.measure.pi_eq MeasureTheory.Measure.pi_eq

variable (μ)

theorem pi'_eq_pi [Encodable ι] : pi' μ = Measure.pi μ :=
  Eq.symm <| pi_eq fun s hs => pi'_pi μ s
#align measure_theory.measure.pi'_eq_pi MeasureTheory.Measure.pi'_eq_pi

@[simp]
theorem pi_pi (s : ∀ i, Set (α i)) : Measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
  by
  haveI : Encodable ι := Fintype.toEncodable ι
  rw [← pi'_eq_pi, pi'_pi]
#align measure_theory.measure.pi_pi MeasureTheory.Measure.pi_pi

theorem pi_univ : Measure.pi μ univ = ∏ i, μ i univ := by rw [← pi_univ, pi_pi μ]
#align measure_theory.measure.pi_univ MeasureTheory.Measure.pi_univ

theorem pi_ball [∀ i, MetricSpace (α i)] (x : ∀ i, α i) {r : ℝ} (hr : 0 < r) :
    Measure.pi μ (Metric.ball x r) = ∏ i, μ i (Metric.ball (x i) r) := by rw [ball_pi _ hr, pi_pi]
#align measure_theory.measure.pi_ball MeasureTheory.Measure.pi_ball

theorem pi_closedBall [∀ i, MetricSpace (α i)] (x : ∀ i, α i) {r : ℝ} (hr : 0 ≤ r) :
    Measure.pi μ (Metric.closedBall x r) = ∏ i, μ i (Metric.closedBall (x i) r) := by
  rw [closedBall_pi _ hr, pi_pi]
#align measure_theory.measure.pi_closed_ball MeasureTheory.Measure.pi_closedBall

instance pi.sigmaFinite : SigmaFinite (Measure.pi μ) :=
  (FiniteSpanningSetsIn.pi fun i => (μ i).toFiniteSpanningSetsIn).SigmaFinite
#align measure_theory.measure.pi.sigma_finite MeasureTheory.Measure.pi.sigmaFinite

theorem pi_of_empty {α : Type _} [IsEmpty α] {β : α → Type _} {m : ∀ a, MeasurableSpace (β a)}
    (μ : ∀ a : α, Measure (β a)) (x : ∀ a, β a := isEmptyElim) : Measure.pi μ = dirac x :=
  by
  haveI : ∀ a, sigma_finite (μ a) := isEmptyElim
  refine' pi_eq fun s hs => _
  rw [Fintype.prod_empty, dirac_apply_of_mem]
  exact isEmptyElim
#align measure_theory.measure.pi_of_empty MeasureTheory.Measure.pi_of_empty

theorem pi_eval_preimage_null {i : ι} {s : Set (α i)} (hs : μ i s = 0) :
    Measure.pi μ (eval i ⁻¹' s) = 0 :=
  by
  -- WLOG, `s` is measurable
  rcases exists_measurable_superset_of_null hs with ⟨t, hst, htm, hμt⟩
  suffices : measure.pi μ (eval i ⁻¹' t) = 0
  exact measure_mono_null (preimage_mono hst) this
  clear! s
  -- Now rewrite it as `set.pi`, and apply `pi_pi`
  rw [← univ_pi_update_univ, pi_pi]
  apply Finset.prod_eq_zero (Finset.mem_univ i)
  simp [hμt]
#align measure_theory.measure.pi_eval_preimage_null MeasureTheory.Measure.pi_eval_preimage_null

theorem pi_hyperplane (i : ι) [HasNoAtoms (μ i)] (x : α i) :
    Measure.pi μ { f : ∀ i, α i | f i = x } = 0 :=
  show Measure.pi μ (eval i ⁻¹' {x}) = 0 from pi_eval_preimage_null _ (measure_singleton x)
#align measure_theory.measure.pi_hyperplane MeasureTheory.Measure.pi_hyperplane

theorem ae_eval_ne (i : ι) [HasNoAtoms (μ i)] (x : α i) : ∀ᵐ y : ∀ i, α i ∂Measure.pi μ, y i ≠ x :=
  compl_mem_ae_iff.2 (pi_hyperplane μ i x)
#align measure_theory.measure.ae_eval_ne MeasureTheory.Measure.ae_eval_ne

variable {μ}

theorem tendsto_eval_ae_ae {i : ι} : Tendsto (eval i) (Measure.pi μ).ae (μ i).ae := fun s hs =>
  pi_eval_preimage_null μ hs
#align measure_theory.measure.tendsto_eval_ae_ae MeasureTheory.Measure.tendsto_eval_ae_ae

theorem ae_pi_le_pi : (Measure.pi μ).ae ≤ Filter.pi fun i => (μ i).ae :=
  le_infᵢ fun i => tendsto_eval_ae_ae.le_comap
#align measure_theory.measure.ae_pi_le_pi MeasureTheory.Measure.ae_pi_le_pi

theorem ae_eq_pi {β : ι → Type _} {f f' : ∀ i, α i → β i} (h : ∀ i, f i =ᵐ[μ i] f' i) :
    (fun (x : ∀ i, α i) i => f i (x i)) =ᵐ[Measure.pi μ] fun x i => f' i (x i) :=
  (eventually_all.2 fun i => tendsto_eval_ae_ae.Eventually (h i)).mono fun x hx => funext hx
#align measure_theory.measure.ae_eq_pi MeasureTheory.Measure.ae_eq_pi

theorem ae_le_pi {β : ι → Type _} [∀ i, Preorder (β i)] {f f' : ∀ i, α i → β i}
    (h : ∀ i, f i ≤ᵐ[μ i] f' i) :
    (fun (x : ∀ i, α i) i => f i (x i)) ≤ᵐ[Measure.pi μ] fun x i => f' i (x i) :=
  (eventually_all.2 fun i => tendsto_eval_ae_ae.Eventually (h i)).mono fun x hx => hx
#align measure_theory.measure.ae_le_pi MeasureTheory.Measure.ae_le_pi

theorem ae_le_set_pi {I : Set ι} {s t : ∀ i, Set (α i)} (h : ∀ i ∈ I, s i ≤ᵐ[μ i] t i) :
    Set.pi I s ≤ᵐ[Measure.pi μ] Set.pi I t :=
  ((eventually_all_finite I.toFinite).2 fun i hi => tendsto_eval_ae_ae.Eventually (h i hi)).mono
    fun x hst hx i hi => hst i hi <| hx i hi
#align measure_theory.measure.ae_le_set_pi MeasureTheory.Measure.ae_le_set_pi

theorem ae_eq_set_pi {I : Set ι} {s t : ∀ i, Set (α i)} (h : ∀ i ∈ I, s i =ᵐ[μ i] t i) :
    Set.pi I s =ᵐ[Measure.pi μ] Set.pi I t :=
  (ae_le_set_pi fun i hi => (h i hi).le).antisymm (ae_le_set_pi fun i hi => (h i hi).symm.le)
#align measure_theory.measure.ae_eq_set_pi MeasureTheory.Measure.ae_eq_set_pi

section Intervals

variable {μ} [∀ i, PartialOrder (α i)] [∀ i, HasNoAtoms (μ i)]

theorem pi_Iio_ae_eq_pi_Iic {s : Set ι} {f : ∀ i, α i} :
    (pi s fun i => Iio (f i)) =ᵐ[Measure.pi μ] pi s fun i => Iic (f i) :=
  ae_eq_set_pi fun i hi => Iio_ae_eq_Iic
#align measure_theory.measure.pi_Iio_ae_eq_pi_Iic MeasureTheory.Measure.pi_Iio_ae_eq_pi_Iic

theorem pi_Ioi_ae_eq_pi_Ici {s : Set ι} {f : ∀ i, α i} :
    (pi s fun i => Ioi (f i)) =ᵐ[Measure.pi μ] pi s fun i => Ici (f i) :=
  ae_eq_set_pi fun i hi => Ioi_ae_eq_Ici
#align measure_theory.measure.pi_Ioi_ae_eq_pi_Ici MeasureTheory.Measure.pi_Ioi_ae_eq_pi_Ici

theorem univ_pi_Iio_ae_eq_Iic {f : ∀ i, α i} :
    (pi univ fun i => Iio (f i)) =ᵐ[Measure.pi μ] Iic f :=
  by
  rw [← pi_univ_Iic]
  exact pi_Iio_ae_eq_pi_Iic
#align measure_theory.measure.univ_pi_Iio_ae_eq_Iic MeasureTheory.Measure.univ_pi_Iio_ae_eq_Iic

theorem univ_pi_Ioi_ae_eq_Ici {f : ∀ i, α i} :
    (pi univ fun i => Ioi (f i)) =ᵐ[Measure.pi μ] Ici f :=
  by
  rw [← pi_univ_Ici]
  exact pi_Ioi_ae_eq_pi_Ici
#align measure_theory.measure.univ_pi_Ioi_ae_eq_Ici MeasureTheory.Measure.univ_pi_Ioi_ae_eq_Ici

theorem pi_Ioo_ae_eq_pi_Icc {s : Set ι} {f g : ∀ i, α i} :
    (pi s fun i => Ioo (f i) (g i)) =ᵐ[Measure.pi μ] pi s fun i => Icc (f i) (g i) :=
  ae_eq_set_pi fun i hi => Ioo_ae_eq_Icc
#align measure_theory.measure.pi_Ioo_ae_eq_pi_Icc MeasureTheory.Measure.pi_Ioo_ae_eq_pi_Icc

theorem pi_Ioo_ae_eq_pi_Ioc {s : Set ι} {f g : ∀ i, α i} :
    (pi s fun i => Ioo (f i) (g i)) =ᵐ[Measure.pi μ] pi s fun i => Ioc (f i) (g i) :=
  ae_eq_set_pi fun i hi => Ioo_ae_eq_Ioc
#align measure_theory.measure.pi_Ioo_ae_eq_pi_Ioc MeasureTheory.Measure.pi_Ioo_ae_eq_pi_Ioc

theorem univ_pi_Ioo_ae_eq_Icc {f g : ∀ i, α i} :
    (pi univ fun i => Ioo (f i) (g i)) =ᵐ[Measure.pi μ] Icc f g :=
  by
  rw [← pi_univ_Icc]
  exact pi_Ioo_ae_eq_pi_Icc
#align measure_theory.measure.univ_pi_Ioo_ae_eq_Icc MeasureTheory.Measure.univ_pi_Ioo_ae_eq_Icc

theorem pi_Ioc_ae_eq_pi_Icc {s : Set ι} {f g : ∀ i, α i} :
    (pi s fun i => Ioc (f i) (g i)) =ᵐ[Measure.pi μ] pi s fun i => Icc (f i) (g i) :=
  ae_eq_set_pi fun i hi => Ioc_ae_eq_Icc
#align measure_theory.measure.pi_Ioc_ae_eq_pi_Icc MeasureTheory.Measure.pi_Ioc_ae_eq_pi_Icc

theorem univ_pi_Ioc_ae_eq_Icc {f g : ∀ i, α i} :
    (pi univ fun i => Ioc (f i) (g i)) =ᵐ[Measure.pi μ] Icc f g :=
  by
  rw [← pi_univ_Icc]
  exact pi_Ioc_ae_eq_pi_Icc
#align measure_theory.measure.univ_pi_Ioc_ae_eq_Icc MeasureTheory.Measure.univ_pi_Ioc_ae_eq_Icc

theorem pi_Ico_ae_eq_pi_Icc {s : Set ι} {f g : ∀ i, α i} :
    (pi s fun i => Ico (f i) (g i)) =ᵐ[Measure.pi μ] pi s fun i => Icc (f i) (g i) :=
  ae_eq_set_pi fun i hi => Ico_ae_eq_Icc
#align measure_theory.measure.pi_Ico_ae_eq_pi_Icc MeasureTheory.Measure.pi_Ico_ae_eq_pi_Icc

theorem univ_pi_Ico_ae_eq_Icc {f g : ∀ i, α i} :
    (pi univ fun i => Ico (f i) (g i)) =ᵐ[Measure.pi μ] Icc f g :=
  by
  rw [← pi_univ_Icc]
  exact pi_Ico_ae_eq_pi_Icc
#align measure_theory.measure.univ_pi_Ico_ae_eq_Icc MeasureTheory.Measure.univ_pi_Ico_ae_eq_Icc

end Intervals

/-- If one of the measures `μ i` has no atoms, them `measure.pi µ`
has no atoms. The instance below assumes that all `μ i` have no atoms. -/
theorem piHasNoAtoms (i : ι) [HasNoAtoms (μ i)] : HasNoAtoms (Measure.pi μ) :=
  ⟨fun x => flip measure_mono_null (pi_hyperplane μ i (x i)) (singleton_subset_iff.2 rfl)⟩
#align measure_theory.measure.pi_has_no_atoms MeasureTheory.Measure.piHasNoAtoms

instance [h : Nonempty ι] [∀ i, HasNoAtoms (μ i)] : HasNoAtoms (Measure.pi μ) :=
  h.elim fun i => piHasNoAtoms i

instance [∀ i, TopologicalSpace (α i)] [∀ i, IsLocallyFiniteMeasure (μ i)] :
    IsLocallyFiniteMeasure (Measure.pi μ) :=
  by
  refine' ⟨fun x => _⟩
  choose s hxs ho hμ using fun i => (μ i).exists_isOpen_measure_lt_top (x i)
  refine' ⟨pi univ s, set_pi_mem_nhds finite_univ fun i hi => IsOpen.mem_nhds (ho i) (hxs i), _⟩
  rw [pi_pi]
  exact ENNReal.prod_lt_top fun i _ => (hμ i).Ne

variable (μ)

@[to_additive]
instance pi.isMulLeftInvariant [∀ i, Group (α i)] [∀ i, HasMeasurableMul (α i)]
    [∀ i, IsMulLeftInvariant (μ i)] : IsMulLeftInvariant (Measure.pi μ) :=
  by
  refine' ⟨fun v => (pi_eq fun s hs => _).symm⟩
  rw [map_apply (measurable_const_mul _) (MeasurableSet.univ_pi hs),
    show (· * ·) v ⁻¹' univ.pi s = univ.pi fun i => (· * ·) (v i) ⁻¹' s i by rfl, pi_pi]
  simp_rw [measure_preimage_mul]
#align measure_theory.measure.pi.is_mul_left_invariant MeasureTheory.Measure.pi.isMulLeftInvariant
#align measure_theory.measure.pi.is_add_left_invariant MeasureTheory.Measure.pi.is_add_left_invariant

@[to_additive]
instance pi.isMulRightInvariant [∀ i, Group (α i)] [∀ i, HasMeasurableMul (α i)]
    [∀ i, IsMulRightInvariant (μ i)] : IsMulRightInvariant (Measure.pi μ) :=
  by
  refine' ⟨fun v => (pi_eq fun s hs => _).symm⟩
  rw [map_apply (measurable_mul_const _) (MeasurableSet.univ_pi hs),
    show (· * v) ⁻¹' univ.pi s = univ.pi fun i => (· * v i) ⁻¹' s i by rfl, pi_pi]
  simp_rw [measure_preimage_mul_right]
#align measure_theory.measure.pi.is_mul_right_invariant MeasureTheory.Measure.pi.isMulRightInvariant
#align measure_theory.measure.pi.is_add_right_invariant MeasureTheory.Measure.pi.is_add_right_invariant

@[to_additive]
instance pi.isInvInvariant [∀ i, Group (α i)] [∀ i, HasMeasurableInv (α i)]
    [∀ i, IsInvInvariant (μ i)] : IsInvInvariant (Measure.pi μ) :=
  by
  refine' ⟨(measure.pi_eq fun s hs => _).symm⟩
  have A : Inv.inv ⁻¹' pi univ s = Set.pi univ fun i => Inv.inv ⁻¹' s i :=
    by
    ext
    simp
  simp_rw [measure.inv, measure.map_apply measurable_inv (MeasurableSet.univ_pi hs), A, pi_pi,
    measure_preimage_inv]
#align measure_theory.measure.pi.is_inv_invariant MeasureTheory.Measure.pi.isInvInvariant
#align measure_theory.measure.pi.is_neg_invariant MeasureTheory.Measure.pi.is_neg_invariant

instance pi.isOpenPosMeasure [∀ i, TopologicalSpace (α i)] [∀ i, IsOpenPosMeasure (μ i)] :
    IsOpenPosMeasure (MeasureTheory.Measure.pi μ) :=
  by
  constructor
  rintro U U_open ⟨a, ha⟩
  obtain ⟨s, ⟨hs, hsU⟩⟩ := isOpen_pi_iff'.1 U_open a ha
  refine' ne_of_gt (lt_of_lt_of_le _ (measure_mono hsU))
  simp only [pi_pi]
  rw [CanonicallyOrderedCommSemiring.prod_pos]
  intro i _
  apply (hs i).1.measure_pos (μ i) ⟨a i, (hs i).2⟩
#align measure_theory.measure.pi.is_open_pos_measure MeasureTheory.Measure.pi.isOpenPosMeasure

instance pi.isFiniteMeasureOnCompacts [∀ i, TopologicalSpace (α i)]
    [∀ i, IsFiniteMeasureOnCompacts (μ i)] :
    IsFiniteMeasureOnCompacts (MeasureTheory.Measure.pi μ) :=
  by
  constructor
  intro K hK
  suffices measure.pi μ (set.univ.pi fun j => Function.eval j '' K) < ⊤ by
    exact lt_of_le_of_lt (measure_mono (univ.subset_pi_eval_image K)) this
  rw [measure.pi_pi]
  refine' WithTop.prod_lt_top _
  exact fun i _ => ne_of_lt (IsCompact.measure_lt_top (IsCompact.image hK (continuous_apply i)))
#align measure_theory.measure.pi.is_finite_measure_on_compacts MeasureTheory.Measure.pi.isFiniteMeasureOnCompacts

@[to_additive]
instance pi.isHaarMeasure [∀ i, Group (α i)] [∀ i, TopologicalSpace (α i)]
    [∀ i, IsHaarMeasure (μ i)] [∀ i, HasMeasurableMul (α i)] : IsHaarMeasure (Measure.pi μ) where
#align measure_theory.measure.pi.is_haar_measure MeasureTheory.Measure.pi.isHaarMeasure
#align measure_theory.measure.pi.is_add_haar_measure MeasureTheory.Measure.pi.is_add_haar_measure

end Measure

instance MeasureSpace.pi [∀ i, MeasureSpace (α i)] : MeasureSpace (∀ i, α i) :=
  ⟨Measure.pi fun i => volume⟩
#align measure_theory.measure_space.pi MeasureTheory.MeasureSpace.pi

theorem volume_pi [∀ i, MeasureSpace (α i)] :
    (volume : Measure (∀ i, α i)) = Measure.pi fun i => volume :=
  rfl
#align measure_theory.volume_pi MeasureTheory.volume_pi

theorem volume_pi_pi [∀ i, MeasureSpace (α i)] [∀ i, SigmaFinite (volume : Measure (α i))]
    (s : ∀ i, Set (α i)) : volume (pi univ s) = ∏ i, volume (s i) :=
  Measure.pi_pi (fun i => volume) s
#align measure_theory.volume_pi_pi MeasureTheory.volume_pi_pi

theorem volume_pi_ball [∀ i, MeasureSpace (α i)] [∀ i, SigmaFinite (volume : Measure (α i))]
    [∀ i, MetricSpace (α i)] (x : ∀ i, α i) {r : ℝ} (hr : 0 < r) :
    volume (Metric.ball x r) = ∏ i, volume (Metric.ball (x i) r) :=
  Measure.pi_ball _ _ hr
#align measure_theory.volume_pi_ball MeasureTheory.volume_pi_ball

theorem volume_pi_closedBall [∀ i, MeasureSpace (α i)] [∀ i, SigmaFinite (volume : Measure (α i))]
    [∀ i, MetricSpace (α i)] (x : ∀ i, α i) {r : ℝ} (hr : 0 ≤ r) :
    volume (Metric.closedBall x r) = ∏ i, volume (Metric.closedBall (x i) r) :=
  Measure.pi_closedBall _ _ hr
#align measure_theory.volume_pi_closed_ball MeasureTheory.volume_pi_closedBall

open Measure

/-- We intentionally restrict this only to the nondependent function space, since type-class
inference cannot find an instance for `ι → ℝ` when this is stated for dependent function spaces. -/
@[to_additive
      "We intentionally restrict this only to the nondependent function space, since\ntype-class inference cannot find an instance for `ι → ℝ` when this is stated for dependent function\nspaces."]
instance Pi.isMulLeftInvariantVolume {α} [Group α] [MeasureSpace α]
    [SigmaFinite (volume : Measure α)] [HasMeasurableMul α]
    [IsMulLeftInvariant (volume : Measure α)] : IsMulLeftInvariant (volume : Measure (ι → α)) :=
  pi.isMulLeftInvariant _
#align measure_theory.pi.is_mul_left_invariant_volume MeasureTheory.Pi.isMulLeftInvariantVolume
#align measure_theory.pi.is_add_left_invariant_volume MeasureTheory.Pi.is_add_left_invariant_volume

/-- We intentionally restrict this only to the nondependent function space, since type-class
inference cannot find an instance for `ι → ℝ` when this is stated for dependent function spaces. -/
@[to_additive
      "We intentionally restrict this only to the nondependent function space, since\ntype-class inference cannot find an instance for `ι → ℝ` when this is stated for dependent function\nspaces."]
instance Pi.isInvInvariantVolume {α} [Group α] [MeasureSpace α] [SigmaFinite (volume : Measure α)]
    [HasMeasurableInv α] [IsInvInvariant (volume : Measure α)] :
    IsInvInvariant (volume : Measure (ι → α)) :=
  pi.isInvInvariant _
#align measure_theory.pi.is_inv_invariant_volume MeasureTheory.Pi.isInvInvariantVolume
#align measure_theory.pi.is_neg_invariant_volume MeasureTheory.Pi.is_neg_invariant_volume

/-!
### Measure preserving equivalences

In this section we prove that some measurable equivalences (e.g., between `fin 1 → α` and `α` or
between `fin 2 → α` and `α × α`) preserve measure or volume. These lemmas can be used to prove that
measures of corresponding sets (images or preimages) have equal measures and functions `f ∘ e` and
`f` have equal integrals, see lemmas in the `measure_theory.measure_preserving` prefix.
-/

section MeasurePreserving

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem measurePreservingPiEquivPiSubtypeProd {ι : Type u} {α : ι → Type v} [Fintype ι]
    {m : ∀ i, MeasurableSpace (α i)} (μ : ∀ i, Measure (α i)) [∀ i, SigmaFinite (μ i)]
    (p : ι → Prop) [DecidablePred p] :
    MeasurePreserving (MeasurableEquiv.piEquivPiSubtypeProd α p) (Measure.pi μ)
      ((Measure.pi fun i : Subtype p => μ i).Prod (Measure.pi fun i => μ i)) :=
  by
  set e := (MeasurableEquiv.piEquivPiSubtypeProd α p).symm
  refine' measure_preserving.symm e _
  refine' ⟨e.measurable, (pi_eq fun s hs => _).symm⟩
  have :
    e ⁻¹' pi univ s =
      (pi univ fun i : { i // p i } => s i) ×ˢ pi univ fun i : { i // ¬p i } => s i :=
    Equiv.preimage_piEquivPiSubtypeProd_symm_pi p s
  rw [e.map_apply, this, prod_prod, pi_pi, pi_pi]
  exact Fintype.prod_subtype_mul_prod_subtype p fun i => μ i (s i)
#align measure_theory.measure_preserving_pi_equiv_pi_subtype_prod MeasureTheory.measurePreservingPiEquivPiSubtypeProd

theorem volumePreservingPiEquivPiSubtypeProd {ι : Type _} (α : ι → Type _) [Fintype ι]
    [∀ i, MeasureSpace (α i)] [∀ i, SigmaFinite (volume : Measure (α i))] (p : ι → Prop)
    [DecidablePred p] : MeasurePreserving (MeasurableEquiv.piEquivPiSubtypeProd α p) :=
  measurePreservingPiEquivPiSubtypeProd (fun i => volume) p
#align measure_theory.volume_preserving_pi_equiv_pi_subtype_prod MeasureTheory.volumePreservingPiEquivPiSubtypeProd

theorem measurePreservingPiFinSuccAboveEquiv {n : ℕ} {α : Fin (n + 1) → Type u}
    {m : ∀ i, MeasurableSpace (α i)} (μ : ∀ i, Measure (α i)) [∀ i, SigmaFinite (μ i)]
    (i : Fin (n + 1)) :
    MeasurePreserving (MeasurableEquiv.piFinSuccAboveEquiv α i) (Measure.pi μ)
      ((μ i).Prod <| Measure.pi fun j => μ (i.succAbove j)) :=
  by
  set e := (MeasurableEquiv.piFinSuccAboveEquiv α i).symm
  refine' measure_preserving.symm e _
  refine' ⟨e.measurable, (pi_eq fun s hs => _).symm⟩
  rw [e.map_apply, i.prod_univ_succ_above _, ← pi_pi, ← prod_prod]
  congr 1 with ⟨x, f⟩
  simp [i.forall_iff_succ_above]
#align measure_theory.measure_preserving_pi_fin_succ_above_equiv MeasureTheory.measurePreservingPiFinSuccAboveEquiv

theorem volumePreservingPiFinSuccAboveEquiv {n : ℕ} (α : Fin (n + 1) → Type u)
    [∀ i, MeasureSpace (α i)] [∀ i, SigmaFinite (volume : Measure (α i))] (i : Fin (n + 1)) :
    MeasurePreserving (MeasurableEquiv.piFinSuccAboveEquiv α i) :=
  measurePreservingPiFinSuccAboveEquiv (fun _ => volume) i
#align measure_theory.volume_preserving_pi_fin_succ_above_equiv MeasureTheory.volumePreservingPiFinSuccAboveEquiv

theorem measurePreservingFunUnique {β : Type u} {m : MeasurableSpace β} (μ : Measure β) (α : Type v)
    [Unique α] : MeasurePreserving (MeasurableEquiv.funUnique α β) (Measure.pi fun a : α => μ) μ :=
  by
  set e := MeasurableEquiv.funUnique α β
  have : (pi_premeasure fun _ : α => μ.to_outer_measure) = measure.map e.symm μ :=
    by
    ext1 s
    rw [pi_premeasure, Fintype.prod_unique, to_outer_measure_apply, e.symm.map_apply]
    congr 1
    exact e.to_equiv.image_eq_preimage s
  simp only [measure.pi, outer_measure.pi, this, bounded_by_measure, to_outer_measure_to_measure]
  exact (e.symm.measurable.measure_preserving _).symm e.symm
#align measure_theory.measure_preserving_fun_unique MeasureTheory.measurePreservingFunUnique

theorem volumePreservingFunUnique (α : Type u) (β : Type v) [Unique α] [MeasureSpace β] :
    MeasurePreserving (MeasurableEquiv.funUnique α β) volume volume :=
  measurePreservingFunUnique volume α
#align measure_theory.volume_preserving_fun_unique MeasureTheory.volumePreservingFunUnique

theorem measurePreservingPiFinTwo {α : Fin 2 → Type u} {m : ∀ i, MeasurableSpace (α i)}
    (μ : ∀ i, Measure (α i)) [∀ i, SigmaFinite (μ i)] :
    MeasurePreserving (MeasurableEquiv.piFinTwo α) (Measure.pi μ) ((μ 0).Prod (μ 1)) :=
  by
  refine' ⟨MeasurableEquiv.measurable _, (measure.prod_eq fun s t hs ht => _).symm⟩
  rw [MeasurableEquiv.map_apply, MeasurableEquiv.piFinTwo_apply, Fin.preimage_apply_01_prod,
    measure.pi_pi, Fin.prod_univ_two]
  rfl
#align measure_theory.measure_preserving_pi_fin_two MeasureTheory.measurePreservingPiFinTwo

theorem volumePreservingPiFinTwo (α : Fin 2 → Type u) [∀ i, MeasureSpace (α i)]
    [∀ i, SigmaFinite (volume : Measure (α i))] :
    MeasurePreserving (MeasurableEquiv.piFinTwo α) volume volume :=
  measurePreservingPiFinTwo _
#align measure_theory.volume_preserving_pi_fin_two MeasureTheory.volumePreservingPiFinTwo

theorem measurePreservingFinTwoArrowVec {α : Type u} {m : MeasurableSpace α} (μ ν : Measure α)
    [SigmaFinite μ] [SigmaFinite ν] :
    MeasurePreserving MeasurableEquiv.finTwoArrow (Measure.pi ![μ, ν]) (μ.Prod ν) :=
  haveI : ∀ i, sigma_finite (![μ, ν] i) := Fin.forall_fin_two.2 ⟨‹_›, ‹_›⟩
  measure_preserving_pi_fin_two _
#align measure_theory.measure_preserving_fin_two_arrow_vec MeasureTheory.measurePreservingFinTwoArrowVec

theorem measurePreservingFinTwoArrow {α : Type u} {m : MeasurableSpace α} (μ : Measure α)
    [SigmaFinite μ] :
    MeasurePreserving MeasurableEquiv.finTwoArrow (Measure.pi fun _ => μ) (μ.Prod μ) := by
  simpa only [Matrix.vec_single_eq_const, Matrix.vecCons_const] using
    measure_preserving_fin_two_arrow_vec μ μ
#align measure_theory.measure_preserving_fin_two_arrow MeasureTheory.measurePreservingFinTwoArrow

theorem volumePreservingFinTwoArrow (α : Type u) [MeasureSpace α]
    [SigmaFinite (volume : Measure α)] :
    MeasurePreserving (@MeasurableEquiv.finTwoArrow α _) volume volume :=
  measurePreservingFinTwoArrow volume
#align measure_theory.volume_preserving_fin_two_arrow MeasureTheory.volumePreservingFinTwoArrow

theorem measurePreservingPiEmpty {ι : Type u} {α : ι → Type v} [IsEmpty ι]
    {m : ∀ i, MeasurableSpace (α i)} (μ : ∀ i, Measure (α i)) :
    MeasurePreserving (MeasurableEquiv.ofUniqueOfUnique (∀ i, α i) Unit) (Measure.pi μ)
      (Measure.dirac ()) :=
  by
  set e := MeasurableEquiv.ofUniqueOfUnique (∀ i, α i) Unit
  refine' ⟨e.measurable, _⟩
  rw [measure.pi_of_empty, measure.map_dirac e.measurable]; rfl
#align measure_theory.measure_preserving_pi_empty MeasureTheory.measurePreservingPiEmpty

theorem volumePreservingPiEmpty {ι : Type u} (α : ι → Type v) [IsEmpty ι]
    [∀ i, MeasureSpace (α i)] :
    MeasurePreserving (MeasurableEquiv.ofUniqueOfUnique (∀ i, α i) Unit) volume volume :=
  measurePreservingPiEmpty fun _ => volume
#align measure_theory.volume_preserving_pi_empty MeasureTheory.volumePreservingPiEmpty

end MeasurePreserving

end MeasureTheory


import data.real.basic tactic.linarith

open real

-- a non-empty bounded-above set S has a max iff sup(S) is in S
theorem Q2d (S : set ℝ) (h1 : ∃ s, s ∈ S) (h2 : ∃ B, ∀ s ∈ S, s ≤ B) :
(∃ m ∈ S, ∀ s ∈ S, s ≤ m) ↔ real.Sup S ∈ S :=
begin
  let t := Sup S,
  -- let's get the key fact about t before we start, namely that t is
  -- a least upper bound!
  -- First let's get the variables from h1 and h2
  cases h1 with s Hs,
  cases h2 with b Hb,
  -- then let's apply the theorem we need.
  have H : is_lub S t := real.is_lub_Sup Hs Hb,
  -- Now we don't need s Hs b Hb any more
  clear Hs s Hb b,
  -- Now we know that t is the least upper bound for S.
  -- Goal still mentions Sup S -- let's change to t.
  change _ ↔ t ∈ S,
  -- Before we start, let's break down H (the statement that t is a LUB for S
  -- into its two parts -- that t is an UB and that t is ≤ all UBs)
  cases H with Ht1 Ht2,
  -- Now let's start.
  split,
  { rintro ⟨m,Hm,Hmax⟩, -- assuming there's a max, call it m.
    -- t is the sup, m is the max. We know m ∈ S, we prove t ∈ S by showing t = m.
    convert Hm,
    have H1 : t ≤ m,
      apply Ht2,
      exact Hmax,
    have H2 : m ≤ t,
      apply Ht1,
      exact Hm,
    linarith },
  { -- sup in S implies its the max
    intro Ht,
    use t,
    use Ht,
    exact Ht1 },
end

theorem Q2f (S : set ℝ) (a : ℝ) :
is_lub S a ∧ is_glb (-S) a ↔
  S = {x : ℝ | x < a} ∨ S = {x : ℝ | x ≤ a}
:=
begin
  split,
  { rintro ⟨h1,h2⟩,
    change is_glb (-S) _ at h2,
    have h3 : ∀ x : ℝ, x < a → x ∈ S,
    { intros x Hx,
      suffices : ¬ (x ∈ -S),
        rw ←set.mem_compl_eq at this,
        rw set.compl_compl at this,
        assumption,
      intro HS,
      have := h2.1 x HS,
      linarith,
    },
    have h4 : ∀ x : ℝ, x > a → x ∈ -S,
      intros x Hx HS,
      have := h1.1 x HS,
      linarith,
    -- So everything < a is in S, and everything > a is not in S.
    -- Now split into cases depending on whether a ∈ S or not.
    cases classical.em (a ∈ S),
    { -- a ∈ S
      right,
      -- two sets are equal iff they have the same elements
      ext,
      split,
      { exact h1.1 x },
      { intro Hx,
        change x ≤ a at Hx,
        rw le_iff_lt_or_eq at Hx,
        cases Hx,
          exact h3 x Hx,
          rwa ←Hx at h
      },
    },
    { left,
      ext,split,
        intro Hx,
        show x < a,
        apply lt_of_le_of_ne,
          exact h1.1 x Hx,
        intro Hxa,
        apply h,
        convert Hx,
        rw Hxa,
      intro Hxa,
      change x < a at Hxa,
      rw ←set.compl_compl S,
      intro h5,
      have := h2.1 x h5,
      linarith }
  },
  intro HS,
  cases HS with H1 H2,
  { rw H1, clear H1, split,
    { split,
      { intros x Hx, exact le_of_lt Hx},
      { intros b Hb,
        apply le_of_not_gt,
        intro Ha,
        have Hc := Hb ((b + a) / 2) (show _ < a, by linarith),
        linarith },
    },
    { have H1 : -{x : ℝ | x < a} = {x : ℝ | a ≤ x},
        ext,simp,
      rw H1, clear H1, split,
      { intros x Hx,exact Hx },
      { intros b Hb,
        exact Hb a (le_refl a),
      },
    },
  },
  {
    sorry
  }
end


import algebra.group.defs
import analysis.inner_product_space.basic
/-!

# The Thermodynamic System and Models
We define a thermodynamic system to be over a general field, which we require to be an albelian group
for multiplication. This class has five properties to describe the system, pressure, volume, temperature,
amount of substance, and energy. Each property is defined as a function from the natural numbers to our
field. This function represents the equillibrium states of the system.

We also define six properties of a thermodynamic system: isobaric, isochoric, isothermal, adiabatic,
closed system, and isolated system. These take in a thermodynamic system and have the type Prop, so
they can be thought of as assertation about the system.

We finally define an ideal gas, which extends the thermodynamic system by providing a model for the systems
properties. So far, the ideal gas only defines the unviersal gas constant and the ideal gas law. Then we show
how the boyles law follows form the ideal gas law and the assumption of isothermal and a closed system
## To Do
  - Add more parameters to the ideal gas model, including ideal models of energy.
  - Define more for energy: heat capacity as a function of temeperature, the first and second law of thermodynamics
    -/

universe u

structure thermo_system :=

(pressure : ℕ → ℝ)
(volume : ℕ → ℝ)
(temperature : ℕ → ℝ)
(substance_amount : ℕ → ℝ)
(internal_energy : ℕ → ℝ)

def isobaric (M : thermo_system) : Prop := ∀ n m : ℕ, M.pressure n = M.pressure m
def isochoric (M : thermo_system) : Prop := ∀ n m : ℕ, M.volume n = M.volume m
def isothermal (M : thermo_system) : Prop := ∀ n m : ℕ, M.temperature n = M.temperature m
def adiabatic (M : thermo_system) : Prop :=  ∀ n m : ℕ, M.internal_energy  n = M.internal_energy m
def closed_system (M : thermo_system) : Prop := ∀ n m : ℕ, M.substance_amount  n = M.substance_amount m
def isolated_system (M : thermo_system) : Prop := adiabatic M ∧ closed_system M

/-!### Gas Laws-/
def boyles_law (M : thermo_system) :=  ∃ (k : ℝ), ∀ n : ℕ, (M.pressure n) * (M.volume n)= k
def charles_law (M : thermo_system) :=  ∃ (k : ℝ), ∀ n : ℕ, (M.volume n) = k * (M.temperature n)
def avogadros_law (M : thermo_system):=  ∃ (k : ℝ), ∀ n : ℕ, (M.volume n) = k * (M.substance_amount n)

variables {M : thermo_system}

theorem boyles_law_relation
: boyles_law M →  ∀ n m, M.pressure n*M.volume n = M.pressure m * M.volume m:=
begin
  intros h n m,
  simp [boyles_law] at h,
  cases h with k h,
  field_simp [h n, h m],
end

theorem boyles_law_relation'

: (∀ n m, M.pressure n * M.volume n = M.pressure m * M.volume m) → boyles_law M :=
begin
  intros h,
  simp [boyles_law],
  use (M.pressure 1 * M.volume 1),
  intro,
  exact h n 1,
end

theorem charles_law_relation
: charles_law M →  ∀ n m, M.volume n * M.temperature m = M.volume m * M.temperature n:=
begin
  intros h n m,
  simp [charles_law] at h,
  cases h with k h,
  rw [h n, h m],
  ring_exp
end

theorem charles_law_relation'
(hT : M.temperature 1 ≠ 0)
: (∀ n m, M.volume n * M.temperature m = M.volume m * M.temperature n) → charles_law M :=
begin
  intros h,
  simp [charles_law],
  use (M.volume 1 / M.temperature 1),
  intro,
  field_simp [h n 1],
end

theorem avogadros_law_relation
: avogadros_law M →  ∀ n m, M.volume n * M.substance_amount m = M.volume m * M.substance_amount n :=
begin
  intros h n m,
  simp [avogadros_law] at h,
  cases h with k h,
  rw [h n, h m],
  ring_exp,
end

theorem avogadros_law_relation'
(hn : M.substance_amount 1 ≠ 0)
: (∀ n m, M.volume n * M.substance_amount m = M.volume m * M.substance_amount n) → avogadros_law M :=
begin
  intros h,
  simp [avogadros_law],
  use (M.volume 1 / M.substance_amount 1),
  intro,
  field_simp [h n 1],
end

/-! ### System models-/
structure ideal_gas
  extends thermo_system  :=
(R : ℝ)
(ideal_gas_law : ∀ n : ℕ, (pressure n)*(volume n) = (substance_amount n)*R*(temperature n))

/-! ### Properties about the ideal gas law-/

theorem ideal_gas_law_relation
{M : ideal_gas}
: ∀ n m : ℕ, (M.pressure n)*(M.volume n)*((M.substance_amount m)*(M.temperature m)) =
(M.pressure m)*(M.volume m)*((M.substance_amount n)*(M.temperature n)):=
begin
  intros,
  let h1 := M.ideal_gas_law n,
  let h2 := M.ideal_gas_law m,
  rw [h1,h2],
  ring_exp,
end

theorem boyles_from_ideal_gas {M : ideal_gas} (iso1 : isothermal M.to_thermo_system)
(iso2 : closed_system M.to_thermo_system)
(hT : ∀ n, M.temperature n ≠ 0)
(hn : ∀ n, M.substance_amount n ≠ 0)
: boyles_law M.to_thermo_system:=
begin
  simp [boyles_law, isothermal, closed_system] at *,
  let h := ideal_gas_law_relation,
  apply boyles_law_relation',
  intros,
  specialize h n m,
  rw [iso1 n m, iso2 n m] at h,
  field_simp [hT m, hn m] at h,
  exact h,
end

theorem charles_from_ideal_gas {M : ideal_gas} (iso1 : isobaric M.to_thermo_system)
(iso2 : closed_system M.to_thermo_system)
(hT : ∀ n, M.temperature n ≠ 0)
(hn : ∀ n, M.substance_amount n ≠ 0)
(hP : ∀ n, M.pressure n ≠ 0)
: charles_law M.to_thermo_system:=
begin
  simp [charles_law, isobaric, closed_system] at *,
  let h := ideal_gas_law_relation,
  apply charles_law_relation' (hT 1),
  intros,
  specialize h n m,
  rw [iso1 n m, iso2 n m] at h,
  field_simp [mul_mul_mul_comm, hP m, hn m] at h,
  exact h,
end

theorem avogadros_from_ideal_gas {M : ideal_gas} (iso1 : isothermal M.to_thermo_system)
(iso2 : isobaric M.to_thermo_system)
(hT : ∀ n, M.temperature n ≠ 0)
(hn : ∀ n, M.substance_amount n ≠ 0)
(hP : ∀ n, M.pressure n ≠ 0)
: avogadros_law M.to_thermo_system:=
begin
  simp [avogadros_law, isothermal, isobaric] at *,
  let h := ideal_gas_law_relation,
  apply avogadros_law_relation' (hn 1),
  intros,
  specialize h n m,
  rw [iso1 n m, iso2 n m] at h,
  rw [mul_comm (M.pressure m), mul_comm (M.pressure m), mul_mul_mul_comm, mul_mul_mul_comm (M.volume m)] at h,
  field_simp [hP m, hT m] at h,
  exact h,
end

/-! ### System Energy-/

def enthalpy (M : thermo_system) := M.internal_energy + M.pressure*M.volume

def change (f : ℕ → ℝ) := λ n, f (n + 1) - f n
notation `Δ` := change


import graphs.id

/-
Now we can define the identity morphism.
-/

def 𝕀 (G : graph) : G ↦ G :=
  morphism.mk (id) (id) (by exact id_compatability G)

/-
Next we turn our attention to defining an isomorphism.
-/

def isomorphism {G H : graph} (α : G ↦ H) : Prop :=
  ∃ β : H ↦ G, α ⊚ β = 𝕀 H ∧ β ⊚ α = 𝕀 G

/-
This is a sanity check: proving that the identity is an isomorphism.
-/
/- Lemma : The identity morphism is an isomorphism.
-/
lemma id_is_iso (G : graph) : isomorphism (𝕀 G) :=
begin
  sorry,

end


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.computation.translations
import algebra.continued_fractions.terminated_stable
import algebra.continued_fractions.continuants_recurrence
import order.filter.at_top_bot

/-!
# Correctness of Terminating Continued Fraction Computations (`generalized_continued_fraction.of`)

## Summary

We show the correctness of the
algorithm computing continued fractions (`generalized_continued_fraction.of`) in case of termination
in the following sense:

At every step `n : ℕ`, we can obtain the value `v` by adding a specific residual term to the last
denominator of the fraction described by `(generalized_continued_fraction.of v).convergents' n`.
The residual term will be zero exactly when the continued fraction terminated; otherwise, the
residual term will be given by the fractional part stored in
`generalized_continued_fraction.int_fract_pair.stream v n`.

For an example, refer to
`generalized_continued_fraction.comp_exact_value_correctness_of_stream_eq_some` and for more
information about the computation process, refer to `algebra.continued_fraction.computation.basic`.

## Main definitions

- `generalized_continued_fraction.comp_exact_value` can be used to compute the exact value
  approximated by the continued fraction `generalized_continued_fraction.of v` by adding a residual
  term as described in the summary.

## Main Theorems

- `generalized_continued_fraction.comp_exact_value_correctness_of_stream_eq_some` shows that
  `generalized_continued_fraction.comp_exact_value` indeed returns the value `v` when given the
  convergent and fractional part as described in the summary.
- `generalized_continued_fraction.of_correctness_of_terminated_at` shows the equality
  `v = (generalized_continued_fraction.of v).convergents n` if `generalized_continued_fraction.of v`
  terminated at position `n`.
-/

namespace generalized_continued_fraction
open generalized_continued_fraction as gcf

variables {K : Type*} [linear_ordered_field K] {v : K} {n : ℕ}

/--
Given two continuants `pconts` and `conts` and a value `fr`, this function returns
- `conts.a / conts.b` if `fr = 0`
- `exact_conts.a / exact_conts.b` where `exact_conts = next_continuants 1 fr⁻¹ pconts conts`
  otherwise.

This function can be used to compute the exact value approxmated by a continued fraction
`generalized_continued_fraction.of v` as described in lemma
`comp_exact_value_correctness_of_stream_eq_some`.
-/
protected def comp_exact_value (pconts conts : gcf.pair K) (fr : K) : K :=
-- if the fractional part is zero, we exactly approximated the value by the last continuants
if fr = 0 then conts.a / conts.b
-- otherwise, we have to include the fractional part in a final continuants step.
else let exact_conts := next_continuants 1 fr⁻¹ pconts conts in
  exact_conts.a / exact_conts.b

variable [floor_ring K]

/-- Just a computational lemma we need for the next main proof. -/
protected lemma comp_exact_value_correctness_of_stream_eq_some_aux_comp {a : K} (b c : K)
  (fract_a_ne_zero : fract a ≠ 0) :
  ((⌊a⌋ : K) * b + c) / (fract a) + b = (b * a + c) / fract a :=
by { field_simp [fract_a_ne_zero], rw [fract], ring }

open generalized_continued_fraction as gcf

/--
Shows the correctness of `comp_exact_value` in case the continued fraction
`generalized_continued_fraction.of v` did not terminate at position `n`. That is, we obtain the
value `v` if we pass the two successive (auxiliary) continuants at positions `n` and `n + 1` as well
as the fractional part at `int_fract_pair.stream n` to `comp_exact_value`.

The correctness might be seen more readily if one uses `convergents'` to evaluate the continued
fraction. Here is an example to illustrate the idea:

Let `(v : ℚ) := 3.4`. We have
- `generalized_continued_fraction.int_fract_pair.stream v 0 = some ⟨3, 0.4⟩`, and
- `generalized_continued_fraction.int_fract_pair.stream v 1 = some ⟨2, 0.5⟩`.
Now `(generalized_continued_fraction.of v).convergents' 1 = 3 + 1/2`, and our fractional term at
position `2` is `0.5`. We hence have `v = 3 + 1/(2 + 0.5) = 3 + 1/2.5 = 3.4`. This computation
corresponds exactly to the one using the recurrence equation in `comp_exact_value`.
-/
lemma comp_exact_value_correctness_of_stream_eq_some :
  ∀ {ifp_n : int_fract_pair K}, int_fract_pair.stream v n = some ifp_n →
    v = gcf.comp_exact_value
          ((gcf.of v).continuants_aux  n)
          ((gcf.of v).continuants_aux $ n + 1)
          ifp_n.fr :=
begin
  let g := gcf.of v,
  induction n with n IH,
  { assume ifp_zero stream_zero_eq, -- nat.zero
    have : int_fract_pair.of v = ifp_zero, by
    { have : int_fract_pair.stream v 0 = some (int_fract_pair.of v), from rfl,
      simpa only [this] using stream_zero_eq },
    cases this,
    cases decidable.em (fract v = 0) with fract_eq_zero fract_ne_zero,
    -- fract v = 0; we must then have `v = ⌊v⌋`
    { suffices : v = ⌊v⌋, by simpa [continuants_aux, fract_eq_zero, gcf.comp_exact_value],
      calc
          v = fract v + ⌊v⌋ : by rw fract_add_floor
        ... = ⌊v⌋           : by simp [fract_eq_zero] },
    -- fract v ≠ 0; the claim then easily follows by unfolding a single computation step
    { field_simp [continuants_aux, next_continuants, next_numerator, next_denominator,
        gcf.of_h_eq_floor, gcf.comp_exact_value, fract_ne_zero] } },
  { assume ifp_succ_n succ_nth_stream_eq,  -- nat.succ
    obtain ⟨ifp_n, nth_stream_eq, nth_fract_ne_zero, -⟩ :
      ∃ ifp_n, int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr ≠ 0
      ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n, from
        int_fract_pair.succ_nth_stream_eq_some_iff.elim_left succ_nth_stream_eq,
    -- introduce some notation
    let conts := g.continuants_aux (n + 2),
    set pconts := g.continuants_aux (n + 1) with pconts_eq,
    set ppconts := g.continuants_aux n with ppconts_eq,
    cases decidable.em (ifp_succ_n.fr = 0) with ifp_succ_n_fr_eq_zero ifp_succ_n_fr_ne_zero,
    -- ifp_succ_n.fr = 0
    { suffices : v = conts.a / conts.b, by
        simpa [gcf.comp_exact_value, ifp_succ_n_fr_eq_zero],
      -- use the IH and the fact that ifp_n.fr⁻¹ = ⌊ifp_n.fr⁻¹⌋ to prove this case
      obtain ⟨ifp_n', nth_stream_eq', ifp_n_fract_inv_eq_floor⟩ :
        ∃ ifp_n, int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr⁻¹ = ⌊ifp_n.fr⁻¹⌋, from
          int_fract_pair.exists_succ_nth_stream_of_fr_zero succ_nth_stream_eq ifp_succ_n_fr_eq_zero,
      have : ifp_n' = ifp_n, by injection (eq.trans (nth_stream_eq').symm nth_stream_eq),
      cases this,
      have s_nth_eq : g.s.nth n = some ⟨1, ⌊ifp_n.fr⁻¹⌋⟩, from
        gcf.nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero nth_stream_eq nth_fract_ne_zero,
      rw [←ifp_n_fract_inv_eq_floor] at s_nth_eq,
      suffices : v = gcf.comp_exact_value ppconts pconts ifp_n.fr, by
        simpa [conts, continuants_aux, s_nth_eq,gcf.comp_exact_value, nth_fract_ne_zero] using this,
      exact (IH nth_stream_eq) },
    -- ifp_succ_n.fr ≠ 0
    { -- use the IH to show that the following equality suffices
      suffices : gcf.comp_exact_value ppconts pconts ifp_n.fr
               = gcf.comp_exact_value pconts conts ifp_succ_n.fr, by
      { have : v = gcf.comp_exact_value ppconts pconts ifp_n.fr, from IH nth_stream_eq,
        conv_lhs { rw this }, assumption },
      -- get the correspondence between ifp_n and ifp_succ_n
      obtain ⟨ifp_n', nth_stream_eq', ifp_n_fract_ne_zero, ⟨refl⟩⟩ :
        ∃ ifp_n, int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr ≠ 0
        ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n, from
          int_fract_pair.succ_nth_stream_eq_some_iff.elim_left succ_nth_stream_eq,
      have : ifp_n' = ifp_n, by injection (eq.trans (nth_stream_eq').symm nth_stream_eq),
      cases this,
      -- get the correspondence between ifp_n and g.s.nth n
      have s_nth_eq : g.s.nth n = some ⟨1, (⌊ifp_n.fr⁻¹⌋ : K)⟩,
        from gcf.nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero nth_stream_eq
          ifp_n_fract_ne_zero,
      -- the claim now follows by unfolding the definitions and tedious calculations
      -- some shorthand notation
      let ppA := ppconts.a, let ppB := ppconts.b,
      let pA := pconts.a, let pB := pconts.b,
      have : gcf.comp_exact_value ppconts pconts ifp_n.fr
          = (ppA + ifp_n.fr⁻¹ * pA) / (ppB + ifp_n.fr⁻¹ * pB), by
        -- unfold comp_exact_value and the convergent computation once
        { field_simp [ifp_n_fract_ne_zero, gcf.comp_exact_value, next_continuants, next_numerator,
          next_denominator], ac_refl },
      rw this,
      -- two calculations needed to show the claim
      have tmp_calc := gcf.comp_exact_value_correctness_of_stream_eq_some_aux_comp
        pA ppA ifp_succ_n_fr_ne_zero,
      have tmp_calc' := gcf.comp_exact_value_correctness_of_stream_eq_some_aux_comp
        pB ppB ifp_succ_n_fr_ne_zero,
      rw inv_eq_one_div at tmp_calc tmp_calc',
      have : fract (1 / ifp_n.fr) ≠ 0, by simpa using ifp_succ_n_fr_ne_zero,
      -- now unfold the recurrence one step and simplify both sides to arrive at the conclusion
      field_simp [conts, gcf.comp_exact_value,
        (gcf.continuants_aux_recurrence s_nth_eq ppconts_eq pconts_eq), next_continuants,
        next_numerator, next_denominator, this, tmp_calc, tmp_calc'],
      ac_refl } }
end

/-- The convergent of `generalized_continued_fraction.of v` at step `n - 1` is exactly `v` if the
`int_fract_pair.stream` of the corresponding continued fraction terminated at step `n`. -/
lemma of_correctness_of_nth_stream_eq_none
  (nth_stream_eq_none : int_fract_pair.stream v n = none) :
  v = (gcf.of v).convergents (n - 1) :=
begin
  induction n with n IH,
  case nat.zero { contradiction }, -- int_fract_pair.stream v 0 ≠ none
  case nat.succ
  { rename nth_stream_eq_none succ_nth_stream_eq_none,
    let g := gcf.of v,
    change v = g.convergents n,
    have : int_fract_pair.stream v n = none
      ∨ ∃ ifp, int_fract_pair.stream v n = some ifp ∧ ifp.fr = 0, from
      int_fract_pair.succ_nth_stream_eq_none_iff.elim_left succ_nth_stream_eq_none,
    rcases this with ⟨nth_stream_eq_none⟩ | ⟨ifp_n, nth_stream_eq, nth_stream_fr_eq_zero⟩,
    { cases n with n',
      { contradiction }, -- int_fract_pair.stream v 0 ≠ none
      { have : g.terminated_at n', from
          gcf.of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none.elim_right
          nth_stream_eq_none,
        have : g.convergents (n' + 1) = g.convergents n', from
          gcf.convergents_stable_of_terminated n'.le_succ this,
        rw this,
        exact (IH nth_stream_eq_none) } },
    { simpa [nth_stream_fr_eq_zero, gcf.comp_exact_value] using
      (comp_exact_value_correctness_of_stream_eq_some nth_stream_eq) } }
end

/--
If `generalized_continued_fraction.of v` terminated at step `n`, then the `n`th convergent is
exactly `v`.
-/
theorem of_correctness_of_terminated_at (terminated_at_n : (gcf.of v).terminated_at n) :
  v = (gcf.of v).convergents n :=
have int_fract_pair.stream v (n + 1) = none, from
  gcf.of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none.elim_left terminated_at_n,
 of_correctness_of_nth_stream_eq_none this

/--
If `generalized_continued_fraction.of v` terminates, then there is `n : ℕ` such that the `n`th
convergent is exactly `v`.
-/
lemma of_correctness_of_terminates (terminates : (gcf.of v).terminates) :
  ∃ (n : ℕ), v = (gcf.of v).convergents n :=
exists.elim terminates
( assume n terminated_at_n,
  exists.intro n (of_correctness_of_terminated_at terminated_at_n) )

open filter

/--
If `generalized_continued_fraction.of v` terminates, then its convergents will eventually always
be `v`.
-/
lemma of_correctness_at_top_of_terminates (terminates : (gcf.of v).terminates) :
  ∀ᶠ n in at_top, v = (gcf.of v).convergents n :=
begin
  rw eventually_at_top,
  obtain ⟨n, terminated_at_n⟩ : ∃ n, (gcf.of v).terminated_at n, from terminates,
  use n,
  assume m m_geq_n,
  rw (gcf.convergents_stable_of_terminated m_geq_n terminated_at_n),
  exact of_correctness_of_terminated_at terminated_at_n
end

end generalized_continued_fraction


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.multiset.lattice
import Mathlib.algebra.gcd_monoid
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# GCD and LCM operations on multisets

## Main definitions

- `multiset.gcd` - the greatest common denominator of a `multiset` of elements of a `gcd_monoid`
- `multiset.lcm` - the least common multiple of a `multiset` of elements of a `gcd_monoid`

## Implementation notes

TODO: simplify with a tactic and `data.multiset.lattice`

## Tags

multiset, gcd
-/

namespace multiset

/-! ### lcm -/

/-- Least common multiple of a multiset -/
def lcm {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    (s : multiset α) : α :=
  fold lcm 1 s

@[simp] theorem lcm_zero {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] : lcm 0 = 1 :=
  fold_zero lcm 1

@[simp] theorem lcm_cons {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (a : α) (s : multiset α) : lcm (a ::ₘ s) = lcm a (lcm s) :=
  fold_cons_left lcm 1 a s

@[simp] theorem lcm_singleton {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {a : α} : lcm (a ::ₘ 0) = coe_fn normalize a :=
  sorry

@[simp] theorem lcm_add {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (s₁ : multiset α) (s₂ : multiset α) : lcm (s₁ + s₂) = lcm (lcm s₁) (lcm s₂) :=
  sorry

theorem lcm_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    {s : multiset α} {a : α} : lcm s ∣ a ↔ ∀ (b : α), b ∈ s → b ∣ a :=
  sorry

theorem dvd_lcm {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    {s : multiset α} {a : α} (h : a ∈ s) : a ∣ lcm s :=
  iff.mp lcm_dvd (dvd_refl (lcm s)) a h

theorem lcm_mono {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    {s₁ : multiset α} {s₂ : multiset α} (h : s₁ ⊆ s₂) : lcm s₁ ∣ lcm s₂ :=
  iff.mpr lcm_dvd fun (b : α) (hb : b ∈ s₁) => dvd_lcm (h hb)

@[simp] theorem normalize_lcm {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (s : multiset α) : coe_fn normalize (lcm s) = lcm s :=
  sorry

@[simp] theorem lcm_erase_dup {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (s : multiset α) : lcm (erase_dup s) = lcm s :=
  sorry

@[simp] theorem lcm_ndunion {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (s₁ : multiset α) (s₂ : multiset α) :
    lcm (ndunion s₁ s₂) = lcm (lcm s₁) (lcm s₂) :=
  sorry

@[simp] theorem lcm_union {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (s₁ : multiset α) (s₂ : multiset α) :
    lcm (s₁ ∪ s₂) = lcm (lcm s₁) (lcm s₂) :=
  sorry

@[simp] theorem lcm_ndinsert {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (a : α) (s : multiset α) : lcm (ndinsert a s) = lcm a (lcm s) :=
  sorry

/-! ### gcd -/

/-- Greatest common divisor of a multiset -/
def gcd {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    (s : multiset α) : α :=
  fold gcd 0 s

@[simp] theorem gcd_zero {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] : gcd 0 = 0 :=
  fold_zero gcd 0

@[simp] theorem gcd_cons {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (a : α) (s : multiset α) : gcd (a ::ₘ s) = gcd a (gcd s) :=
  fold_cons_left gcd 0 a s

@[simp] theorem gcd_singleton {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {a : α} : gcd (a ::ₘ 0) = coe_fn normalize a :=
  sorry

@[simp] theorem gcd_add {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (s₁ : multiset α) (s₂ : multiset α) : gcd (s₁ + s₂) = gcd (gcd s₁) (gcd s₂) :=
  sorry

theorem dvd_gcd {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    {s : multiset α} {a : α} : a ∣ gcd s ↔ ∀ (b : α), b ∈ s → a ∣ b :=
  sorry

theorem gcd_dvd {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    {s : multiset α} {a : α} (h : a ∈ s) : gcd s ∣ a :=
  iff.mp dvd_gcd (dvd_refl (gcd s)) a h

theorem gcd_mono {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    {s₁ : multiset α} {s₂ : multiset α} (h : s₁ ⊆ s₂) : gcd s₂ ∣ gcd s₁ :=
  iff.mpr dvd_gcd fun (b : α) (hb : b ∈ s₁) => gcd_dvd (h hb)

@[simp] theorem normalize_gcd {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (s : multiset α) : coe_fn normalize (gcd s) = gcd s :=
  sorry

theorem gcd_eq_zero_iff {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] (s : multiset α) : gcd s = 0 ↔ ∀ (x : α), x ∈ s → x = 0 :=
  sorry

@[simp] theorem gcd_erase_dup {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (s : multiset α) : gcd (erase_dup s) = gcd s :=
  sorry

@[simp] theorem gcd_ndunion {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (s₁ : multiset α) (s₂ : multiset α) :
    gcd (ndunion s₁ s₂) = gcd (gcd s₁) (gcd s₂) :=
  sorry

@[simp] theorem gcd_union {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (s₁ : multiset α) (s₂ : multiset α) :
    gcd (s₁ ∪ s₂) = gcd (gcd s₁) (gcd s₂) :=
  sorry

@[simp] theorem gcd_ndinsert {α : Type u_1} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] [DecidableEq α] (a : α) (s : multiset α) : gcd (ndinsert a s) = gcd a (gcd s) :=
  sorry

end Mathlib


import SciLean.Core

namespace SciLean

  variable {X} [Hilbert X]

  def εnorm (ε : ℝ) (x : X) : ℝ := Math.sqrt (∥x∥² + ε^2)
  argument x [Fact (ε≠0)]
    isSmooth     := sorry,
    diff_simp    := ⟪dx, x⟫ / εnorm ε x by sorry,
    hasAdjDiff   := by constructor; infer_instance; simp; intro; infer_instance; done,
    adjDiff_simp := (dx' / εnorm ε x) * x by (simp[adjointDifferential]; unfold hold; simp; done)

  notation "∥" x "∥{" ε "}" => εnorm ε x

  @[simp]
  theorem εnorm.is_norm_at_zero (x : X) : ∥x∥{0} = ∥x∥ := sorry

  instance εnorm.isNonNegative           (x : X) : Fact (∥x∥{ε} ≥ 0) := sorry
  instance εnorm.isPositive [Fact (ε≠0)] (x : X) : Fact (∥x∥{ε} > 0) := sorry

  instance εnorm.pow.arg_x.isSmooth   [Fact (ε≠0)] : IsSmooth λ (x : X) (y : ℝ) => ∥x∥{ε}^y := sorry
  instance εnorm.pow.arg_x.hasAdjDiff [Fact (ε≠0)] (y : ℝ) : IsSmooth λ (x : X) => ∥x∥{ε}^y := sorry
  @[simp] theorem εnorm.pow.arg_x.diff_simp [Fact (ε≠0)]
    : (∂ λ (x : X) (y : ℝ) => ∥x∥{ε}^y) = λ x dx y => (y * ⟪dx,x⟫) * ∥x∥{ε}^(y-(2:ℝ)) := sorry
  @[simp] theorem εnorm.pow.arg_x.fwdDiff_simp [Fact (ε≠0)] (y : ℝ)
    : (∂† λ (x : X) => ∥x∥{ε}^y) = λ (x : X) dx' => (y * dx' * ∥x∥{ε}^(y-(2:ℝ))) * x := sorry


import analysis.normed_space.inner_product
import linear_algebra.tensor_product

open_locale tensor_product

/--
Hilbert space
-/
class complex_hilbert_space (V : Type*) extends inner_product_space ℂ V :=
(hilbert_ness: 1=1)

variables {ℋ : Type*} [complex_hilbert_space ℋ]

/--
The Trace of a linear map on a complex Hilbert space.
-/
def Tr (E : module.End ℂ ℋ) : ℂ := sorry
-- noncomputable def Tr := linear_map.trace ℂ ℋ

/--
Adjoint of a linear map
-/
def is_adjoint_pair (A A' : module.End ℂ ℋ) := ∀ x y, inner x (A y) = (inner (A' x) y : ℂ) -- assumes A is bounded

/--
Conjugate of a linear map
-/
def is_conjugate_pair (A A' : module.End ℂ ℋ) := ∀ x y, inner x (A y) = complex.conj (inner x (A y))

/--
Conjugate adjoint of a linear map
-/
def is_dagger_pair (A A' : module.End ℂ ℋ) := ∀ x y, inner x (A y) = complex.conj (inner (A' x) y)

notation U`†` := sorry -- conjugate transpose of U

/--
A unitary is a linear map U : H → H such that U†  = U⁻¹
-/
class unitary (U : module.End ℂ ℋ) :=
(unitarity : U ∘ U† = λ x : ℋ, x)

/--
Unitary maps over a Hilbert space ℋ form a group
-/
def unitary_group := {U : module.End ℂ ℋ // U ∘ U† = λ x : ℋ, x}

instance : group unitary_group := sorry
-- Tip: see how complex numbers are proven to form a group.

/--
dagger_of_unitary is a function that takes a module endomorphism that satisfies
the unitarity axioms and returns another module endomorphism.
-/
def dagger_of_unitary (U : module.End ℂ ℋ) [unitary U] : module.End ℂ ℋ := sorry

notation U`†`:100 := dagger_of_unitary U -- 100 tells Lean that † should be applied with high priority, e.g. before the composition operator ∘.

-- TODO it's not clear to me that module.End ℂ H has inverses, so how could we define unitarity then?
-- it should have inverses because it's called `endomorphism`, but since it's defined with more generality than linear maps (it's defined over any semimodule) then anything goes
-- an example of a semimodule is (ℕ, multiset) and it's clear that no morphism is invertible there except the identity

variables {U : module.End ℂ ℋ} [unitary U]

lemma dag_comp_self_eq_one : U† ∘ U = (1 : module.End ℂ ℋ) := sorry
-- does this follow from something or is it actually an axiom?

variables
{ℋ₁ : Type*} [complex_hilbert_space ℋ₁]
{ℋ₂ : Type*} [complex_hilbert_space ℋ₂]

instance : complex_hilbert_space (ℋ₁ ⊗[ℂ] ℋ₂) := sorry


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

import topology.homotopy.basic

/-!

# Homotopy equivalences between topological spaces

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

In this file, we define homotopy equivalences between topological spaces `X` and `Y` as a pair of
functions `f : C(X, Y)` and `g : C(Y, X)` such that `f.comp g` and `g.comp f` are both homotopic
to `id`.

## Main definitions

- `continuous_map.homotopy_equiv` is the type of homotopy equivalences between topological spaces.

## Notation

We introduce the notation `X ≃ₕ Y` for `continuous_map.homotopy_equiv X Y` in the `continuous_map`
locale.

-/

universes u v w

variables {X : Type u} {Y : Type v} {Z : Type w}
variables [topological_space X] [topological_space Y] [topological_space Z]

namespace continuous_map

/--
A homotopy equivalence between topological spaces `X` and `Y` are a pair of functions
`to_fun : C(X, Y)` and `inv_fun : C(Y, X)` such that `to_fun.comp inv_fun` and `inv_fun.comp to_fun`
are both homotopic to `id`.
-/
@[ext]
structure homotopy_equiv (X : Type u) (Y : Type v) [topological_space X] [topological_space Y] :=
(to_fun : C(X, Y))
(inv_fun : C(Y, X))
(left_inv : (inv_fun.comp to_fun).homotopic (continuous_map.id X))
(right_inv : (to_fun.comp inv_fun).homotopic (continuous_map.id Y))

localized "infix (name := continuous_map.homotopy_equiv)
  ` ≃ₕ `:25 := continuous_map.homotopy_equiv" in continuous_map

namespace homotopy_equiv

instance : has_coe_to_fun (homotopy_equiv X Y) (λ _, X → Y) := ⟨λ h, h.to_fun⟩

@[simp]
lemma to_fun_eq_coe (h : homotopy_equiv X Y) : (h.to_fun : X → Y) = h := rfl

@[continuity]
lemma continuous (h : homotopy_equiv X Y) : continuous h := h.to_fun.continuous

end homotopy_equiv

end continuous_map

open_locale continuous_map

namespace homeomorph

/--
Any homeomorphism is a homotopy equivalence.
-/
def to_homotopy_equiv (h : X ≃ₜ Y) : X ≃ₕ Y :=
{ to_fun := ⟨h⟩,
  inv_fun := ⟨h.symm⟩,
  left_inv := by { convert continuous_map.homotopic.refl _, ext, simp },
  right_inv := by { convert continuous_map.homotopic.refl _, ext, simp } }

@[simp]
lemma coe_to_homotopy_equiv (h : X ≃ₜ Y) : ⇑(h.to_homotopy_equiv) = h := rfl

end homeomorph

namespace continuous_map

namespace homotopy_equiv

/--
If `X` is homotopy equivalent to `Y`, then `Y` is homotopy equivalent to `X`.
-/
def symm (h : X ≃ₕ Y) : Y ≃ₕ X :=
{ to_fun := h.inv_fun,
  inv_fun := h.to_fun,
  left_inv := h.right_inv,
  right_inv := h.left_inv }

@[simp]
lemma coe_inv_fun (h : homotopy_equiv X Y) : (⇑h.inv_fun : Y → X) = ⇑h.symm := rfl

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
because it is a composition of multiple projections. -/
def simps.apply (h : X ≃ₕ Y) : X → Y := h
/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
because it is a composition of multiple projections. -/
def simps.symm_apply (h : X ≃ₕ Y) : Y → X := h.symm

initialize_simps_projections homotopy_equiv (to_fun_to_fun -> apply,
  inv_fun_to_fun -> symm_apply, -to_fun, -inv_fun)

/--
Any topological space is homotopy equivalent to itself.
-/
@[simps]
def refl (X : Type u) [topological_space X] : X ≃ₕ X :=
(homeomorph.refl X).to_homotopy_equiv

instance : inhabited (homotopy_equiv unit unit) := ⟨refl unit⟩

/--
If `X` is homotopy equivalent to `Y`, and `Y` is homotopy equivalent to `Z`, then `X` is homotopy
equivalent to `Z`.
-/
@[simps]
def trans (h₁ : X ≃ₕ Y) (h₂ : Y ≃ₕ Z) : X ≃ₕ Z :=
{ to_fun := h₂.to_fun.comp h₁.to_fun,
  inv_fun := h₁.inv_fun.comp h₂.inv_fun,
  left_inv := begin
    refine homotopic.trans _ h₁.left_inv,
    change ((h₁.inv_fun.comp h₂.inv_fun).comp (h₂.to_fun.comp h₁.to_fun)) with
      h₁.inv_fun.comp ((h₂.inv_fun.comp h₂.to_fun).comp h₁.to_fun),
    refine homotopic.hcomp _ (homotopic.refl _),
    refine homotopic.trans ((homotopic.refl _).hcomp h₂.left_inv) _,
    -- simp,
    rw continuous_map.id_comp,
  end,
  right_inv := begin
    refine homotopic.trans _ h₂.right_inv,
    change ((h₂.to_fun.comp h₁.to_fun).comp (h₁.inv_fun.comp h₂.inv_fun)) with
      h₂.to_fun.comp ((h₁.to_fun.comp h₁.inv_fun).comp h₂.inv_fun),
    refine homotopic.hcomp _ (homotopic.refl _),
    refine homotopic.trans ((homotopic.refl _).hcomp h₁.right_inv) _,
    rw id_comp,
  end }

lemma symm_trans (h₁ : X ≃ₕ Y) (h₂ : Y ≃ₕ Z) :
  (h₁.trans h₂).symm = h₂.symm.trans h₁.symm := by ext; refl

end homotopy_equiv

end continuous_map

open continuous_map

namespace homeomorph

@[simp]
lemma refl_to_homotopy_equiv (X : Type u) [topological_space X] :
  (homeomorph.refl X).to_homotopy_equiv = homotopy_equiv.refl X := rfl

@[simp]
lemma symm_to_homotopy_equiv (h : X ≃ₜ Y) :
  h.symm.to_homotopy_equiv = h.to_homotopy_equiv.symm := rfl

@[simp]
lemma trans_to_homotopy_equiv (h₀ : X ≃ₜ Y) (h₁ : Y ≃ₜ Z) :
  (h₀.trans h₁).to_homotopy_equiv = h₀.to_homotopy_equiv.trans h₁.to_homotopy_equiv := rfl

end homeomorph


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri, Sebastien Gouezel
-/

import topology.fiber_bundle
import topology.algebra.module.basic

/-!
# Topological vector bundles

In this file we define topological vector bundles.

Let `B` be the base space. In our formalism, a topological vector bundle is by definition the type
`bundle.total_space E` where `E : B → Type*` is a function associating to
`x : B` the fiber over `x`. This type `bundle.total_space E` is just a type synonym for
`Σ (x : B), E x`, with the interest that one can put another topology than on `Σ (x : B), E x`
which has the disjoint union topology.

To have a topological vector bundle structure on `bundle.total_space E`,
one should addtionally have the following data:

* `F` should be a topological space and a module over a semiring `R`;
* There should be a topology on `bundle.total_space E`, for which the projection to `B` is
a topological fiber bundle with fiber `F` (in particular, each fiber `E x` is homeomorphic to `F`);
* For each `x`, the fiber `E x` should be a topological vector space over `R`, and the injection
from `E x` to `bundle.total_space F E` should be an embedding;
* The most important condition: around each point, there should be a bundle trivialization which
is a continuous linear equiv in the fibers.

If all these conditions are satisfied, we register the typeclass
`topological_vector_bundle R F E`. We emphasize that the data is provided by other classes, and
that the `topological_vector_bundle` class is `Prop`-valued.

The point of this formalism is that it is unbundled in the sense that the total space of the bundle
is a type with a topology, with which one can work or put further structure, and still one can
perform operations on topological vector bundles (which are yet to be formalized). For instance,
assume that `E₁ : B → Type*` and `E₂ : B → Type*` define two topological vector bundles over `R`
with fiber models `F₁` and `F₂` which are normed spaces. Then one can construct the vector bundle of
continuous linear maps from `E₁ x` to `E₂ x` with fiber `E x := (E₁ x →L[R] E₂ x)` (and with the
topology inherited from the norm-topology on `F₁ →L[R] F₂`, without the need to define the strong
topology on continuous linear maps between general topological vector spaces). Let
`vector_bundle_continuous_linear_map R F₁ E₁ F₂ E₂ (x : B)` be a type synonym for `E₁ x →L[R] E₂ x`.
Then one can endow
`bundle.total_space (vector_bundle_continuous_linear_map R F₁ E₁ F₂ E₂)`
with a topology and a topological vector bundle structure.

Similar constructions can be done for tensor products of topological vector bundles, exterior
algebras, and so on, where the topology can be defined using a norm on the fiber model if this
helps.

## Tags
Vector bundle
-/

noncomputable theory

open bundle set

variables (R : Type*) {B : Type*} (F : Type*) (E : B → Type*)
[semiring R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
[topological_space F] [add_comm_monoid F] [module R F]
[topological_space (total_space E)] [topological_space B]

section

/-- Local trivialization for vector bundles. -/
@[nolint has_inhabited_instance]
structure topological_vector_bundle.trivialization extends to_fiber_bundle_trivialization :
  topological_fiber_bundle.trivialization F (proj E) :=
(linear : ∀ x ∈ base_set, is_linear_map R (λ y : (E x), (to_fun y).2))

open topological_vector_bundle

instance : has_coe_to_fun (trivialization R F E) (λ _, total_space E → B × F) := ⟨λ e, e.to_fun⟩

instance : has_coe (trivialization R F E) (topological_fiber_bundle.trivialization F (proj E)) :=
⟨topological_vector_bundle.trivialization.to_fiber_bundle_trivialization⟩

namespace topological_vector_bundle

variables {R F E}

lemma trivialization.mem_source (e : trivialization R F E)
  {x : total_space E} : x ∈ e.source ↔ proj E x ∈ e.base_set :=
topological_fiber_bundle.trivialization.mem_source e

@[simp, mfld_simps] lemma trivialization.coe_coe (e : trivialization R F E) :
  ⇑e.to_local_homeomorph = e := rfl

@[simp, mfld_simps] lemma trivialization.coe_fst (e : trivialization R F E) {x : total_space E}
  (ex : x ∈ e.source) : (e x).1 = (proj E) x := e.proj_to_fun x ex

end topological_vector_bundle

end

variables [∀ x, topological_space (E x)]

/-- The space `total_space E` (for `E : B → Type*` such that each `E x` is a topological vector
space) has a topological vector space structure with fiber `F` (denoted with
`topological_vector_bundle R F E`) if around every point there is a fiber bundle trivialization
which is linear in the fibers. -/
class topological_vector_bundle : Prop :=
(inducing [] : ∀ (b : B), inducing (λ x : (E b), (id ⟨b, x⟩ : total_space E)))
(locally_trivial [] : ∀ b : B, ∃ e : topological_vector_bundle.trivialization R F E, b ∈ e.base_set)

variable [topological_vector_bundle R F E]

namespace topological_vector_bundle

/-- `trivialization_at R F E b` is some choice of trivialization of a vector bundle whose base set
contains a given point `b`. -/
def trivialization_at : Π b : B, trivialization R F E :=
λ b, classical.some (locally_trivial R F E b)

@[simp, mfld_simps] lemma mem_base_set_trivialization_at (b : B) :
  b ∈ (trivialization_at R F E b).base_set :=
classical.some_spec (locally_trivial R F E b)

@[simp, mfld_simps] lemma mem_source_trivialization_at (z : total_space E) :
  z ∈ (trivialization_at R F E z.1).source :=
by { rw topological_fiber_bundle.trivialization.mem_source, apply mem_base_set_trivialization_at }

variables {R F E}

namespace trivialization

/-- In a topological vector bundle, a trivialization in the fiber (which is a priori only linear)
is in fact a continuous linear equiv between the fibers and the model fiber. -/
def continuous_linear_equiv_at (e : trivialization R F E) (b : B)
  (hb : b ∈ e.base_set) : E b ≃L[R] F :=
{ to_fun := λ y, (e ⟨b, y⟩).2,
  inv_fun := λ z, begin
    have : ((e.to_local_homeomorph.symm) (b, z)).fst = b :=
      topological_fiber_bundle.trivialization.proj_symm_apply' _ hb,
    have C : E ((e.to_local_homeomorph.symm) (b, z)).fst = E b, by rw this,
    exact cast C (e.to_local_homeomorph.symm (b, z)).2
  end,
  left_inv := begin
    assume v,
    rw [← heq_iff_eq],
    apply (cast_heq _ _).trans,
    have A : (b, (e ⟨b, v⟩).snd) = e ⟨b, v⟩,
    { refine prod.ext _ rfl,
      symmetry,
      exact topological_fiber_bundle.trivialization.coe_fst' _ hb },
    have B : e.to_local_homeomorph.symm (e ⟨b, v⟩) = ⟨b, v⟩,
    { apply local_homeomorph.left_inv_on,
      rw topological_fiber_bundle.trivialization.mem_source,
      exact hb },
    rw [A, B],
  end,
  right_inv := begin
    assume v,
    have B : e (e.to_local_homeomorph.symm (b, v)) = (b, v),
    { apply local_homeomorph.right_inv_on,
      rw topological_fiber_bundle.trivialization.mem_target,
      exact hb },
    have C : (e (e.to_local_homeomorph.symm (b, v))).2 = v, by rw [B],
    conv_rhs { rw ← C },
    dsimp,
    congr,
    ext,
    { exact (topological_fiber_bundle.trivialization.proj_symm_apply' _ hb).symm },
    { exact (cast_heq _ _).trans (by refl) },
  end,
  map_add' := λ v w, (e.linear _ hb).map_add v w,
  map_smul' := λ c v, (e.linear _ hb).map_smul c v,
  continuous_to_fun := begin
    refine continuous_snd.comp _,
    apply continuous_on.comp_continuous e.to_local_homeomorph.continuous_on
      (topological_vector_bundle.inducing R F E b).continuous (λ x, _),
    rw topological_fiber_bundle.trivialization.mem_source,
    exact hb,
  end,
  continuous_inv_fun := begin
    rw (topological_vector_bundle.inducing R F E b).continuous_iff,
    dsimp,
    have : continuous (λ (z : F), e.to_fiber_bundle_trivialization.to_local_homeomorph.symm (b, z)),
    { apply e.to_local_homeomorph.symm.continuous_on.comp_continuous
        (continuous_const.prod_mk continuous_id') (λ z, _),
      simp only [topological_fiber_bundle.trivialization.mem_target, hb, local_equiv.symm_source,
        local_homeomorph.symm_to_local_equiv] },
    convert this,
    ext z,
    { exact (topological_fiber_bundle.trivialization.proj_symm_apply' _ hb).symm },
    { exact cast_heq _ _ },
  end }

@[simp] lemma continuous_linear_equiv_at_apply (e : trivialization R F E) (b : B)
  (hb : b ∈ e.base_set) (y : E b) : e.continuous_linear_equiv_at b hb y = (e ⟨b, y⟩).2 := rfl

@[simp] lemma continuous_linear_equiv_at_apply' (e : trivialization R F E)
  (x : total_space E) (hx : x ∈ e.source) :
  e.continuous_linear_equiv_at (proj E x) (e.mem_source.1 hx) x.2 = (e x).2 := by { cases x, refl }

end trivialization

section
local attribute [reducible] bundle.trivial

instance {B : Type*} {F : Type*} [add_comm_monoid F] (b : B) :
  add_comm_monoid (bundle.trivial B F b) := ‹add_comm_monoid F›

instance {B : Type*} {F : Type*} [add_comm_group F] (b : B) :
  add_comm_group (bundle.trivial B F b) := ‹add_comm_group F›

instance {B : Type*} {F : Type*} [add_comm_monoid F] [module R F] (b : B) :
  module R (bundle.trivial B F b) := ‹module R F›

end

variables (R B F)
/-- Local trivialization for trivial bundle. -/
def trivial_topological_vector_bundle.trivialization : trivialization R F (bundle.trivial B F) :=
{ to_fun := λ x, (x.fst, x.snd),
  inv_fun := λ y, ⟨y.fst, y.snd⟩,
  source := univ,
  target := univ,
  map_source' := λ x h, mem_univ (x.fst, x.snd),
  map_target' :=λ y h,  mem_univ ⟨y.fst, y.snd⟩,
  left_inv' := λ x h, sigma.eq rfl rfl,
  right_inv' := λ x h, prod.ext rfl rfl,
  open_source := is_open_univ,
  open_target := is_open_univ,
  continuous_to_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
    simp only [prod.topological_space, induced_inf, induced_compose], exact le_rfl, },
  continuous_inv_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
    simp only [bundle.total_space.topological_space, induced_inf, induced_compose],
    exact le_rfl, },
  base_set := univ,
  open_base_set := is_open_univ,
  source_eq := rfl,
  target_eq := by simp only [univ_prod_univ],
  proj_to_fun := λ y hy, rfl,
  linear := λ x hx, ⟨λ y z, rfl, λ c y, rfl⟩ }

instance trivial_bundle.topological_vector_bundle :
  topological_vector_bundle R F (bundle.trivial B F) :=
{ locally_trivial := λ x, ⟨trivial_topological_vector_bundle.trivialization R B F, mem_univ x⟩,
  inducing := λ b, ⟨begin
    have : (λ (x : trivial B F b), x) = @id F, by { ext x, refl },
    simp only [total_space.topological_space, induced_inf, induced_compose, function.comp, proj,
      induced_const, top_inf_eq, trivial.proj_snd, id.def, trivial.topological_space, this,
      induced_id],
  end⟩ }

variables {R B F}

/- Not registered as an instance because of a metavariable. -/
lemma is_topological_vector_bundle_is_topological_fiber_bundle :
  is_topological_fiber_bundle F (proj E) :=
λ x, ⟨(trivialization_at R F E x).to_fiber_bundle_trivialization,
  mem_base_set_trivialization_at R F E x⟩

end topological_vector_bundle

/-! ### Constructing topological vector bundles -/

variables (B)

/-- Analogous construction of `topological_fiber_bundle_core` for vector bundles. This
construction gives a way to construct vector bundles from a structure registering how
trivialization changes act on fibers.-/
@[nolint has_inhabited_instance]
structure topological_vector_bundle_core (ι : Type*) :=
(base_set          : ι → set B)
(is_open_base_set  : ∀ i, is_open (base_set i))
(index_at          : B → ι)
(mem_base_set_at   : ∀ x, x ∈ base_set (index_at x))
(coord_change      : ι → ι → B → (F →ₗ[R] F))
(coord_change_self : ∀ i, ∀ x ∈ base_set i, ∀ v, coord_change i i x v = v)
(coord_change_continuous : ∀ i j, continuous_on (λp : B × F, coord_change i j p.1 p.2)
                                               (((base_set i) ∩ (base_set j)) ×ˢ (univ : set F)))
(coord_change_comp : ∀ i j k, ∀ x ∈ (base_set i) ∩ (base_set j) ∩ (base_set k), ∀ v,
  (coord_change j k x) (coord_change i j x v) = coord_change i k x v)

attribute [simp, mfld_simps] topological_vector_bundle_core.mem_base_set_at

namespace topological_vector_bundle_core

variables {R B F} {ι : Type*} (Z : topological_vector_bundle_core R B F ι)

/-- Natural identification to a `topological_fiber_bundle_core`. -/
def to_topological_vector_bundle_core : topological_fiber_bundle_core ι B F :=
{ coord_change := λ i j b, Z.coord_change i j b, ..Z }

instance to_topological_vector_bundle_core_coe : has_coe (topological_vector_bundle_core R B F ι)
  (topological_fiber_bundle_core ι B F) := ⟨to_topological_vector_bundle_core⟩

include Z

lemma coord_change_linear_comp (i j k : ι): ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j) ∩ (Z.base_set k),
  (Z.coord_change j k x).comp (Z.coord_change i j x) = Z.coord_change i k x :=
λ x hx, by { ext v, exact Z.coord_change_comp i j k x hx v }

/-- The index set of a topological vector bundle core, as a convenience function for dot notation -/
@[nolint unused_arguments has_inhabited_instance]
def index := ι

/-- The base space of a topological vector bundle core, as a convenience function for dot notation-/
@[nolint unused_arguments, reducible]
def base := B

/-- The fiber of a topological vector bundle core, as a convenience function for dot notation and
typeclass inference -/
@[nolint unused_arguments has_inhabited_instance]
def fiber (x : B) := F

section fiber_instances

local attribute [reducible] fiber --just to record instances

instance topological_space_fiber (x : B) : topological_space (Z.fiber x) := by apply_instance
instance add_comm_monoid_fiber : ∀ (x : B), add_comm_monoid (Z.fiber x) := λ x, by apply_instance
instance module_fiber : ∀ (x : B), module R (Z.fiber x) := λ x, by apply_instance

end fiber_instances

/-- The projection from the total space of a topological fiber bundle core, on its base. -/
@[reducible, simp, mfld_simps] def proj : total_space Z.fiber → B := bundle.proj Z.fiber

/-- Local homeomorphism version of the trivialization change. -/
def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
topological_fiber_bundle_core.triv_change ↑Z i j

@[simp, mfld_simps] lemma mem_triv_change_source (i j : ι) (p : B × F) :
  p ∈ (Z.triv_change i j).source ↔ p.1 ∈ Z.base_set i ∩ Z.base_set j :=
topological_fiber_bundle_core.mem_triv_change_source ↑Z i j p

variable (ι)

/-- Topological structure on the total space of a topological bundle created from core, designed so
that all the local trivialization are continuous. -/
instance to_topological_space : topological_space (total_space Z.fiber) :=
topological_fiber_bundle_core.to_topological_space ι ↑Z

variables {ι} (b : B) (a : F)

@[simp, mfld_simps] lemma coe_cord_change (i j : ι) :
  topological_fiber_bundle_core.coord_change ↑Z i j b = Z.coord_change i j b := rfl

/-- Extended version of the local trivialization of a fiber bundle constructed from core,
registering additionally in its type that it is a local bundle trivialization. -/
def local_triv (i : ι) : topological_vector_bundle.trivialization R F Z.fiber :=
{ linear := λ x hx,
  { map_add := λ v w, by simp only [linear_map.map_add] with mfld_simps,
    map_smul := λ r v, by simp only [linear_map.map_smul] with mfld_simps},
  ..topological_fiber_bundle_core.local_triv ↑Z i }

@[simp, mfld_simps] lemma mem_local_triv_source (i : ι) (p : total_space Z.fiber) :
  p ∈ (Z.local_triv i).source ↔ p.1 ∈ Z.base_set i :=
iff.rfl

/-- Preferred local trivialization of a vector bundle constructed from core, at a given point, as
a bundle trivialization -/
def local_triv_at (b : B) : topological_vector_bundle.trivialization R F Z.fiber :=
Z.local_triv (Z.index_at b)

lemma mem_source_at : (⟨b, a⟩ : total_space Z.fiber) ∈ (Z.local_triv_at b).source :=
by { rw [local_triv_at, mem_local_triv_source], exact Z.mem_base_set_at b }

@[simp, mfld_simps] lemma local_triv_at_apply : ((Z.local_triv_at b) ⟨b, a⟩) = ⟨b, a⟩ :=
topological_fiber_bundle_core.local_triv_at_apply Z b a

instance : topological_vector_bundle R F Z.fiber :=
{ inducing := λ b, ⟨ begin refine le_antisymm _ (λ s h, _),
    { rw ←continuous_iff_le_induced,
      exact topological_fiber_bundle_core.continuous_total_space_mk ↑Z b, },
    { refine is_open_induced_iff.mpr ⟨(Z.local_triv_at b).source ∩ (Z.local_triv_at b) ⁻¹'
        ((Z.local_triv_at b).base_set ×ˢ s), (continuous_on_open_iff
        (Z.local_triv_at b).open_source).mp (Z.local_triv_at b).continuous_to_fun _
        ((Z.local_triv_at b).open_base_set.prod h), _⟩,
      rw [preimage_inter, ←preimage_comp, function.comp],
      simp only [id.def],
      refine ext_iff.mpr (λ a, ⟨λ ha, _, λ ha, ⟨Z.mem_base_set_at b, _⟩⟩),
      { simp only [mem_prod, mem_preimage, mem_inter_eq, local_triv_at_apply] at ha,
        exact ha.2.2, },
      { simp only [mem_prod, mem_preimage, mem_inter_eq, local_triv_at_apply],
        exact ⟨Z.mem_base_set_at b, ha⟩, } } end⟩,
  locally_trivial := λ b, ⟨Z.local_triv_at b, Z.mem_base_set_at b⟩, }

/-- The projection on the base of a topological vector bundle created from core is continuous -/
@[continuity] lemma continuous_proj : continuous Z.proj :=
topological_fiber_bundle_core.continuous_proj Z

/-- The projection on the base of a topological vector bundle created from core is an open map -/
lemma is_open_map_proj : is_open_map Z.proj :=
topological_fiber_bundle_core.is_open_map_proj Z

end topological_vector_bundle_core