/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import topology.continuous_function.bounded
import topology.algebra.module.weak_dual
import measure_theory.integral.bochner

/-!
# Finite measures

This file defines the type of finite measures on a given measurable space. When the underlying
space has a topology and the measurable space structure (sigma algebra) is finer than the Borel
sigma algebra, then the type of finite measures is equipped with the topology of weak convergence
of measures. The topology of weak convergence is the coarsest topology w.r.t. which
for every bounded continuous `ℝ≥0`-valued function `f`, the integration of `f` against the
measure is continuous.

## Main definitions

The main definitions are
 * the type `measure_theory.finite_measure Ω` with the topology of weak convergence;
 * `measure_theory.finite_measure.to_weak_dual_bcnn : finite_measure Ω → (weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0))`
   allowing to interpret a finite measure as a continuous linear functional on the space of
   bounded continuous nonnegative functions on `Ω`. This is used for the definition of the
   topology of weak convergence.

## Main results

 * Finite measures `μ` on `Ω` give rise to continuous linear functionals on the space of
   bounded continuous nonnegative functions on `Ω` via integration:
   `measure_theory.finite_measure.to_weak_dual_bcnn : finite_measure Ω → (weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0))`
 * `measure_theory.finite_measure.tendsto_iff_forall_integral_tendsto`: Convergence of finite
   measures is characterized by the convergence of integrals of all bounded continuous functions.
   This shows that the chosen definition of topology coincides with the common textbook definition
   of weak convergence of measures. A similar characterization by the convergence of integrals (in
   the `measure_theory.lintegral` sense) of all bounded continuous nonnegative functions is
   `measure_theory.finite_measure.tendsto_iff_forall_lintegral_tendsto`.

## Implementation notes

The topology of weak convergence of finite Borel measures is defined using a mapping from
`measure_theory.finite_measure Ω` to `weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0)`, inheriting the topology from the
latter.

The implementation of `measure_theory.finite_measure Ω` and is directly as a subtype of
`measure_theory.measure Ω`, and the coercion to a function is the composition `ennreal.to_nnreal`
and the coercion to function of `measure_theory.measure Ω`. Another alternative would have been to
use a bijection with `measure_theory.vector_measure Ω ℝ≥0` as an intermediate step. Some
considerations:
 * Potential advantages of using the `nnreal`-valued vector measure alternative:
   * The coercion to function would avoid need to compose with `ennreal.to_nnreal`, the
     `nnreal`-valued API could be more directly available.
 * Potential drawbacks of the vector measure alternative:
   * The coercion to function would lose monotonicity, as non-measurable sets would be defined to
     have measure 0.
   * No integration theory directly. E.g., the topology definition requires
     `measure_theory.lintegral` w.r.t. a coercion to `measure_theory.measure Ω` in any case.

## References

* [Billingsley, *Convergence of probability measures*][billingsley1999]

## Tags

weak convergence of measures, finite measure

-/

noncomputable theory
open measure_theory
open set
open filter
open bounded_continuous_function
open_locale topology ennreal nnreal bounded_continuous_function

namespace measure_theory

namespace finite_measure

section finite_measure
/-! ### Finite measures

In this section we define the `Type` of `finite_measure Ω`, when `Ω` is a measurable space. Finite
measures on `Ω` are a module over `ℝ≥0`.

If `Ω` is moreover a topological space and the sigma algebra on `Ω` is finer than the Borel sigma
algebra (i.e. `[opens_measurable_space Ω]`), then `finite_measure Ω` is equipped with the topology
of weak convergence of measures. This is implemented by defining a pairing of finite measures `μ`
on `Ω` with continuous bounded nonnegative functions `f : Ω →ᵇ ℝ≥0` via integration, and using the
associated weak topology (essentially the weak-star topology on the dual of `Ω →ᵇ ℝ≥0`).
-/

variables {Ω : Type*} [measurable_space Ω]

/-- Finite measures are defined as the subtype of measures that have the property of being finite
measures (i.e., their total mass is finite). -/
def _root_.measure_theory.finite_measure (Ω : Type*) [measurable_space Ω] : Type* :=
{μ : measure Ω // is_finite_measure μ}

/-- A finite measure can be interpreted as a measure. -/
instance : has_coe (finite_measure Ω) (measure_theory.measure Ω) := coe_subtype

instance is_finite_measure (μ : finite_measure Ω) :
  is_finite_measure (μ : measure Ω) := μ.prop

instance : has_coe_to_fun (finite_measure Ω) (λ _, set Ω → ℝ≥0) :=
⟨λ μ s, (μ s).to_nnreal⟩

lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : finite_measure Ω) :
  (ν : set Ω → ℝ≥0) = λ s, ((ν : measure Ω) s).to_nnreal := rfl

@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : finite_measure Ω) (s : set Ω) :
  (ν s : ℝ≥0∞) = (ν : measure Ω) s := ennreal.coe_to_nnreal (measure_lt_top ↑ν s).ne

@[simp] lemma val_eq_to_measure (ν : finite_measure Ω) : ν.val = (ν : measure Ω) := rfl

lemma coe_injective : function.injective (coe : finite_measure Ω → measure Ω) :=
subtype.coe_injective

lemma apply_mono (μ : finite_measure Ω) {s₁ s₂ : set Ω} (h : s₁ ⊆ s₂) :
  μ s₁ ≤ μ s₂ :=
begin
  change ((μ : measure Ω) s₁).to_nnreal ≤ ((μ : measure Ω) s₂).to_nnreal,
  have key : (μ : measure Ω) s₁ ≤ (μ : measure Ω) s₂ := (μ : measure Ω).mono h,
  apply (ennreal.to_nnreal_le_to_nnreal (measure_ne_top _ s₁) (measure_ne_top _ s₂)).mpr key,
end

/-- The (total) mass of a finite measure `μ` is `μ univ`, i.e., the cast to `nnreal` of
`(μ : measure Ω) univ`. -/
def mass (μ : finite_measure Ω) : ℝ≥0 := μ univ

@[simp] lemma ennreal_mass {μ : finite_measure Ω} :
  (μ.mass : ℝ≥0∞) = (μ : measure Ω) univ := ennreal_coe_fn_eq_coe_fn_to_measure μ set.univ

instance has_zero : has_zero (finite_measure Ω) :=
{ zero := ⟨0, measure_theory.is_finite_measure_zero⟩ }

@[simp] lemma zero.mass : (0 : finite_measure Ω).mass = 0 := rfl

@[simp] lemma mass_zero_iff (μ : finite_measure Ω) : μ.mass = 0 ↔ μ = 0 :=
begin
  refine ⟨λ μ_mass, _, (λ hμ, by simp only [hμ, zero.mass])⟩,
  ext1,
  apply measure.measure_univ_eq_zero.mp,
  rwa [← ennreal_mass, ennreal.coe_eq_zero],
end

lemma mass_nonzero_iff (μ : finite_measure Ω) : μ.mass ≠ 0 ↔ μ ≠ 0 :=
begin
  rw not_iff_not,
  exact finite_measure.mass_zero_iff μ,
end

@[ext] lemma eq_of_forall_measure_apply_eq (μ ν : finite_measure Ω)
  (h : ∀ (s : set Ω), measurable_set s → (μ : measure Ω) s = (ν : measure Ω) s) :
  μ = ν :=
by { ext1, ext1 s s_mble, exact h s s_mble, }

lemma eq_of_forall_apply_eq (μ ν : finite_measure Ω)
  (h : ∀ (s : set Ω), measurable_set s → μ s = ν s) :
  μ = ν :=
begin
  ext1 s s_mble,
  simpa [ennreal_coe_fn_eq_coe_fn_to_measure] using congr_arg (coe : ℝ≥0 → ℝ≥0∞) (h s s_mble),
end

instance : inhabited (finite_measure Ω) := ⟨0⟩

instance : has_add (finite_measure Ω) :=
{ add := λ μ ν, ⟨μ + ν, measure_theory.is_finite_measure_add⟩ }

variables {R : Type*} [has_smul R ℝ≥0] [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0 ℝ≥0∞]
  [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]

instance : has_smul R (finite_measure Ω) :=
{ smul := λ (c : R) μ, ⟨c • μ, measure_theory.is_finite_measure_smul_of_nnreal_tower⟩, }

@[simp, norm_cast] lemma coe_zero : (coe : finite_measure Ω → measure Ω) 0 = 0 := rfl

@[simp, norm_cast] lemma coe_add (μ ν : finite_measure Ω) : ↑(μ + ν) = (↑μ + ↑ν : measure Ω) := rfl

@[simp, norm_cast] lemma coe_smul (c : R) (μ : finite_measure Ω) :
  ↑(c • μ) = (c • ↑μ : measure Ω) := rfl

@[simp, norm_cast] lemma coe_fn_zero :
  (⇑(0 : finite_measure Ω) : set Ω → ℝ≥0) = (0 : set Ω → ℝ≥0) := by { funext, refl, }

@[simp, norm_cast] lemma coe_fn_add (μ ν : finite_measure Ω) :
  (⇑(μ + ν) : set Ω → ℝ≥0) = (⇑μ + ⇑ν : set Ω → ℝ≥0) :=
by { funext, simp [← ennreal.coe_eq_coe], }

@[simp, norm_cast] lemma coe_fn_smul [is_scalar_tower R ℝ≥0 ℝ≥0] (c : R) (μ : finite_measure Ω) :
  (⇑(c • μ) : set Ω → ℝ≥0) = c • (⇑μ : set Ω → ℝ≥0) :=
by { funext, simp [← ennreal.coe_eq_coe, ennreal.coe_smul], }

instance : add_comm_monoid (finite_measure Ω) :=
coe_injective.add_comm_monoid coe coe_zero coe_add (λ _ _, coe_smul _ _)

/-- Coercion is an `add_monoid_hom`. -/
@[simps]
def coe_add_monoid_hom : finite_measure Ω →+ measure Ω :=
{ to_fun := coe, map_zero' := coe_zero, map_add' := coe_add }

instance {Ω : Type*} [measurable_space Ω] : module ℝ≥0 (finite_measure Ω) :=
function.injective.module _ coe_add_monoid_hom coe_injective coe_smul

@[simp] lemma coe_fn_smul_apply [is_scalar_tower R ℝ≥0 ℝ≥0]
  (c : R) (μ : finite_measure Ω) (s : set Ω) :
  (c • μ) s  = c • (μ s) :=
by { simp only [coe_fn_smul, pi.smul_apply], }

/-- Restrict a finite measure μ to a set A. -/
def restrict (μ : finite_measure Ω) (A : set Ω) : finite_measure Ω :=
{ val := (μ : measure Ω).restrict A,
  property := measure_theory.is_finite_measure_restrict μ A, }

lemma restrict_measure_eq (μ : finite_measure Ω) (A : set Ω) :
  (μ.restrict A : measure Ω) = (μ : measure Ω).restrict A := rfl

lemma restrict_apply_measure (μ : finite_measure Ω) (A : set Ω)
  {s : set Ω} (s_mble : measurable_set s) :
  (μ.restrict A : measure Ω) s = (μ : measure Ω) (s ∩ A) :=
measure.restrict_apply s_mble

lemma restrict_apply (μ : finite_measure Ω) (A : set Ω)
  {s : set Ω} (s_mble : measurable_set s) :
  (μ.restrict A) s = μ (s ∩ A) :=
begin
  apply congr_arg ennreal.to_nnreal,
  exact measure.restrict_apply s_mble,
end

lemma restrict_mass (μ : finite_measure Ω) (A : set Ω) :
  (μ.restrict A).mass = μ A :=
by simp only [mass, restrict_apply μ A measurable_set.univ, univ_inter]

lemma restrict_eq_zero_iff (μ : finite_measure Ω) (A : set Ω) :
  μ.restrict A = 0 ↔ μ A = 0 :=
by rw [← mass_zero_iff, restrict_mass]

lemma restrict_nonzero_iff (μ : finite_measure Ω) (A : set Ω) :
  μ.restrict A ≠ 0 ↔ μ A ≠ 0 :=
by rw [← mass_nonzero_iff, restrict_mass]

variables [topological_space Ω]

/-- The pairing of a finite (Borel) measure `μ` with a nonnegative bounded continuous
function is obtained by (Lebesgue) integrating the (test) function against the measure.
This is `finite_measure.test_against_nn`. -/
def test_against_nn (μ : finite_measure Ω) (f : Ω →ᵇ ℝ≥0) : ℝ≥0 :=
(∫⁻ ω, f ω ∂(μ : measure Ω)).to_nnreal

lemma _root_.bounded_continuous_function.nnreal.to_ennreal_comp_measurable {Ω : Type*}
  [topological_space Ω] [measurable_space Ω] [opens_measurable_space Ω] (f : Ω →ᵇ ℝ≥0) :
  measurable (λ ω, (f ω : ℝ≥0∞)) :=
measurable_coe_nnreal_ennreal.comp f.continuous.measurable

lemma _root_.measure_theory.lintegral_lt_top_of_bounded_continuous_to_nnreal
  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ≥0) :
  ∫⁻ ω, f ω ∂μ < ∞ :=
begin
  apply is_finite_measure.lintegral_lt_top_of_bounded_to_ennreal,
  use nndist f 0,
  intros x,
  have key := bounded_continuous_function.nnreal.upper_bound f x,
  rw ennreal.coe_le_coe,
  have eq : nndist f 0 = ⟨dist f 0, dist_nonneg⟩,
  { ext,
    simp only [real.coe_to_nnreal', max_eq_left_iff, subtype.coe_mk, coe_nndist], },
  rwa eq at key,
end

@[simp] lemma test_against_nn_coe_eq {μ : finite_measure Ω} {f : Ω →ᵇ ℝ≥0} :
  (μ.test_against_nn f : ℝ≥0∞) = ∫⁻ ω, f ω ∂(μ : measure Ω) :=
ennreal.coe_to_nnreal (lintegral_lt_top_of_bounded_continuous_to_nnreal _ f).ne

lemma test_against_nn_const (μ : finite_measure Ω) (c : ℝ≥0) :
  μ.test_against_nn (bounded_continuous_function.const Ω c) = c * μ.mass :=
by simp [← ennreal.coe_eq_coe]

lemma test_against_nn_mono (μ : finite_measure Ω)
  {f g : Ω →ᵇ ℝ≥0} (f_le_g : (f : Ω → ℝ≥0) ≤ g) :
  μ.test_against_nn f ≤ μ.test_against_nn g :=
begin
  simp only [←ennreal.coe_le_coe, test_against_nn_coe_eq],
  exact lintegral_mono (λ ω, ennreal.coe_mono (f_le_g ω)),
end

@[simp] lemma test_against_nn_zero (μ : finite_measure Ω) : μ.test_against_nn 0 = 0 :=
by simpa only [zero_mul] using μ.test_against_nn_const 0

@[simp] lemma test_against_nn_one (μ : finite_measure Ω) : μ.test_against_nn 1 = μ.mass :=
begin
  simp only [test_against_nn, coe_one, pi.one_apply, ennreal.coe_one, lintegral_one],
  refl,
end

@[simp] lemma zero.test_against_nn_apply (f : Ω →ᵇ ℝ≥0) :
  (0 : finite_measure Ω).test_against_nn f = 0 :=
by simp only [test_against_nn, coe_zero, lintegral_zero_measure, ennreal.zero_to_nnreal]

lemma zero.test_against_nn : (0 : finite_measure Ω).test_against_nn = 0 :=
by { funext, simp only [zero.test_against_nn_apply, pi.zero_apply], }

@[simp] lemma smul_test_against_nn_apply (c : ℝ≥0) (μ : finite_measure Ω) (f : Ω →ᵇ ℝ≥0) :
  (c • μ).test_against_nn f  = c • (μ.test_against_nn f) :=
by simp only [test_against_nn, coe_smul, smul_eq_mul, ← ennreal.smul_to_nnreal,
  ennreal.smul_def, lintegral_smul_measure]

variables [opens_measurable_space Ω]

lemma test_against_nn_add (μ : finite_measure Ω) (f₁ f₂ : Ω →ᵇ ℝ≥0) :
  μ.test_against_nn (f₁ + f₂) = μ.test_against_nn f₁ + μ.test_against_nn f₂ :=
begin
  simp only [←ennreal.coe_eq_coe, bounded_continuous_function.coe_add, ennreal.coe_add,
             pi.add_apply, test_against_nn_coe_eq],
  exact lintegral_add_left (bounded_continuous_function.nnreal.to_ennreal_comp_measurable _) _
end

lemma test_against_nn_smul [is_scalar_tower R ℝ≥0 ℝ≥0] [pseudo_metric_space R] [has_zero R]
  [has_bounded_smul R ℝ≥0]
  (μ : finite_measure Ω) (c : R) (f : Ω →ᵇ ℝ≥0) :
  μ.test_against_nn (c • f) = c • μ.test_against_nn f :=
begin
  simp only [←ennreal.coe_eq_coe, bounded_continuous_function.coe_smul,
             test_against_nn_coe_eq, ennreal.coe_smul],
  simp_rw [←smul_one_smul ℝ≥0∞ c (f _ : ℝ≥0∞), ←smul_one_smul ℝ≥0∞ c (lintegral _ _ : ℝ≥0∞),
           smul_eq_mul],
  exact @lintegral_const_mul _ _ (μ : measure Ω) (c • 1)  _
                   (bounded_continuous_function.nnreal.to_ennreal_comp_measurable f),
end

lemma test_against_nn_lipschitz_estimate (μ : finite_measure Ω) (f g : Ω →ᵇ ℝ≥0) :
  μ.test_against_nn f ≤ μ.test_against_nn g + (nndist f g) * μ.mass :=
begin
  simp only [←μ.test_against_nn_const (nndist f g), ←test_against_nn_add, ←ennreal.coe_le_coe,
             bounded_continuous_function.coe_add, const_apply, ennreal.coe_add, pi.add_apply,
             coe_nnreal_ennreal_nndist, test_against_nn_coe_eq],
  apply lintegral_mono,
  have le_dist : ∀ ω, dist (f ω) (g ω) ≤ nndist f g :=
  bounded_continuous_function.dist_coe_le_dist,
  intros ω,
  have le' : f ω ≤ g ω + nndist f g,
  { apply (nnreal.le_add_nndist (f ω) (g ω)).trans,
    rw add_le_add_iff_left,
    exact dist_le_coe.mp (le_dist ω), },
  have le : (f ω : ℝ≥0∞) ≤ (g ω : ℝ≥0∞) + (nndist f g),
  by { rw ←ennreal.coe_add, exact ennreal.coe_mono le', },
  rwa [coe_nnreal_ennreal_nndist] at le,
end

lemma test_against_nn_lipschitz (μ : finite_measure Ω) :
  lipschitz_with μ.mass (λ (f : Ω →ᵇ ℝ≥0), μ.test_against_nn f) :=
begin
  rw lipschitz_with_iff_dist_le_mul,
  intros f₁ f₂,
  suffices : abs (μ.test_against_nn f₁ - μ.test_against_nn f₂ : ℝ) ≤ μ.mass * (dist f₁ f₂),
  { rwa nnreal.dist_eq, },
  apply abs_le.mpr,
  split,
  { have key' := μ.test_against_nn_lipschitz_estimate f₂ f₁,
    rw mul_comm at key',
    suffices : ↑(μ.test_against_nn f₂) ≤ ↑(μ.test_against_nn f₁) + ↑(μ.mass) * dist f₁ f₂,
    { linarith, },
    have key := nnreal.coe_mono key',
    rwa [nnreal.coe_add, nnreal.coe_mul, nndist_comm] at key, },
  { have key' := μ.test_against_nn_lipschitz_estimate f₁ f₂,
    rw mul_comm at key',
    suffices : ↑(μ.test_against_nn f₁) ≤ ↑(μ.test_against_nn f₂) + ↑(μ.mass) * dist f₁ f₂,
    { linarith, },
    have key := nnreal.coe_mono key',
    rwa [nnreal.coe_add, nnreal.coe_mul] at key, },
end

/-- Finite measures yield elements of the `weak_dual` of bounded continuous nonnegative
functions via `measure_theory.finite_measure.test_against_nn`, i.e., integration. -/
def to_weak_dual_bcnn (μ : finite_measure Ω) :
  weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0) :=
{ to_fun := λ f, μ.test_against_nn f,
  map_add' := test_against_nn_add μ,
  map_smul' := test_against_nn_smul μ,
  cont := μ.test_against_nn_lipschitz.continuous, }

@[simp] lemma coe_to_weak_dual_bcnn (μ : finite_measure Ω) :
  ⇑μ.to_weak_dual_bcnn = μ.test_against_nn := rfl

@[simp] lemma to_weak_dual_bcnn_apply (μ : finite_measure Ω) (f : Ω →ᵇ ℝ≥0) :
  μ.to_weak_dual_bcnn f = (∫⁻ x, f x ∂(μ : measure Ω)).to_nnreal := rfl

/-- The topology of weak convergence on `measure_theory.finite_measure Ω` is inherited (induced)
from the weak-* topology on `weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0)` via the function
`measure_theory.finite_measure.to_weak_dual_bcnn`. -/
instance : topological_space (finite_measure Ω) :=
topological_space.induced to_weak_dual_bcnn infer_instance

lemma to_weak_dual_bcnn_continuous :
  continuous (@to_weak_dual_bcnn Ω _ _ _) :=
continuous_induced_dom

/- Integration of (nonnegative bounded continuous) test functions against finite Borel measures
depends continuously on the measure. -/
lemma continuous_test_against_nn_eval (f : Ω →ᵇ ℝ≥0) :
  continuous (λ (μ : finite_measure Ω), μ.test_against_nn f) :=
(by apply (weak_bilin.eval_continuous _ _).comp to_weak_dual_bcnn_continuous :
  continuous ((λ φ : weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0), φ f) ∘ to_weak_dual_bcnn))

/-- The total mass of a finite measure depends continuously on the measure. -/
lemma continuous_mass : continuous (λ (μ : finite_measure Ω), μ.mass) :=
by { simp_rw ←test_against_nn_one, exact continuous_test_against_nn_eval 1, }

/-- Convergence of finite measures implies the convergence of their total masses. -/
lemma _root_.filter.tendsto.mass {γ : Type*} {F : filter γ}
  {μs : γ → finite_measure Ω} {μ : finite_measure Ω} (h : tendsto μs F (𝓝 μ)) :
  tendsto (λ i, (μs i).mass) F (𝓝 μ.mass) :=
(continuous_mass.tendsto μ).comp h

lemma tendsto_iff_weak_star_tendsto {γ : Type*} {F : filter γ}
  {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
  tendsto μs F (𝓝 μ) ↔ tendsto (λ i, (μs(i)).to_weak_dual_bcnn) F (𝓝 μ.to_weak_dual_bcnn) :=
inducing.tendsto_nhds_iff ⟨rfl⟩

theorem tendsto_iff_forall_to_weak_dual_bcnn_tendsto
  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
  tendsto μs F (𝓝 μ) ↔
  ∀ (f : Ω →ᵇ ℝ≥0), tendsto (λ i, (μs i).to_weak_dual_bcnn f) F (𝓝 (μ.to_weak_dual_bcnn f)) :=
by { rw [tendsto_iff_weak_star_tendsto, tendsto_iff_forall_eval_tendsto_top_dual_pairing], refl, }

theorem tendsto_iff_forall_test_against_nn_tendsto
  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
  tendsto μs F (𝓝 μ) ↔
  ∀ (f : Ω →ᵇ ℝ≥0), tendsto (λ i, (μs i).test_against_nn f) F (𝓝 (μ.test_against_nn f)) :=
by { rw finite_measure.tendsto_iff_forall_to_weak_dual_bcnn_tendsto, refl, }

/-- If the total masses of finite measures tend to zero, then the measures tend to
zero. This formulation concerns the associated functionals on bounded continuous
nonnegative test functions. See `finite_measure.tendsto_zero_of_tendsto_zero_mass` for
a formulation stating the weak convergence of measures. -/
lemma tendsto_zero_test_against_nn_of_tendsto_zero_mass
  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω}
  (mass_lim : tendsto (λ i, (μs i).mass) F (𝓝 0)) (f : Ω →ᵇ ℝ≥0) :
  tendsto (λ i, (μs i).test_against_nn f) F (𝓝 0) :=
begin
  apply tendsto_iff_dist_tendsto_zero.mpr,
  have obs := λ i, (μs i).test_against_nn_lipschitz_estimate f 0,
  simp_rw [test_against_nn_zero, zero_add] at obs,
  simp_rw (show ∀ i, dist ((μs i).test_against_nn f) 0 = (μs i).test_against_nn f,
    by simp only [dist_nndist, nnreal.nndist_zero_eq_val', eq_self_iff_true,
                  implies_true_iff]),
  refine squeeze_zero (λ i, nnreal.coe_nonneg _) obs _,
  simp_rw nnreal.coe_mul,
  have lim_pair : tendsto (λ i, (⟨nndist f 0, (μs i).mass⟩ : ℝ × ℝ)) F (𝓝 (⟨nndist f 0, 0⟩)),
  { refine (prod.tendsto_iff _ _).mpr ⟨tendsto_const_nhds, _⟩,
    exact (nnreal.continuous_coe.tendsto 0).comp mass_lim, },
  have key := tendsto_mul.comp lim_pair,
  rwa mul_zero at key,
end

/-- If the total masses of finite measures tend to zero, then the measures tend to zero. -/
lemma tendsto_zero_of_tendsto_zero_mass {γ : Type*} {F : filter γ}
  {μs : γ → finite_measure Ω} (mass_lim : tendsto (λ i, (μs i).mass) F (𝓝 0)) :
  tendsto μs F (𝓝 0) :=
begin
  rw tendsto_iff_forall_test_against_nn_tendsto,
  intro f,
  convert tendsto_zero_test_against_nn_of_tendsto_zero_mass mass_lim f,
  rw [zero.test_against_nn_apply],
end

/-- A characterization of weak convergence in terms of integrals of bounded continuous
nonnegative functions. -/
theorem tendsto_iff_forall_lintegral_tendsto {γ : Type*} {F : filter γ}
  {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
  tendsto μs F (𝓝 μ) ↔
  ∀ (f : Ω →ᵇ ℝ≥0),
    tendsto (λ i, (∫⁻ x, (f x) ∂(μs(i) : measure Ω))) F (𝓝 ((∫⁻ x, (f x) ∂(μ : measure Ω)))) :=
begin
  rw tendsto_iff_forall_to_weak_dual_bcnn_tendsto,
  simp_rw [to_weak_dual_bcnn_apply _ _, ←test_against_nn_coe_eq,
           ennreal.tendsto_coe, ennreal.to_nnreal_coe],
end

end finite_measure -- section

section finite_measure_bounded_convergence
/-! ### Bounded convergence results for finite measures

This section is about bounded convergence theorems for finite measures.
-/

variables {Ω : Type*} [measurable_space Ω] [topological_space Ω] [opens_measurable_space Ω]

/-- A bounded convergence theorem for a finite measure:
If bounded continuous non-negative functions are uniformly bounded by a constant and tend to a
limit, then their integrals against the finite measure tend to the integral of the limit.
This formulation assumes:
 * the functions tend to a limit along a countably generated filter;
 * the limit is in the almost everywhere sense;
 * boundedness holds almost everywhere;
 * integration is `measure_theory.lintegral`, i.e., the functions and their integrals are
   `ℝ≥0∞`-valued.
-/
lemma tendsto_lintegral_nn_filter_of_le_const {ι : Type*} {L : filter ι} [L.is_countably_generated]
  (μ : measure Ω) [is_finite_measure μ] {fs : ι → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0}
  (fs_le_const : ∀ᶠ i in L, ∀ᵐ (ω : Ω) ∂μ, fs i ω ≤ c) {f : Ω → ℝ≥0}
  (fs_lim : ∀ᵐ (ω : Ω) ∂μ, tendsto (λ i, fs i ω) L (𝓝 (f ω))) :
  tendsto (λ i, (∫⁻ ω, fs i ω ∂μ)) L (𝓝 (∫⁻ ω, (f ω) ∂μ)) :=
begin
  simpa only using tendsto_lintegral_filter_of_dominated_convergence (λ _, c)
    (eventually_of_forall ((λ i, (ennreal.continuous_coe.comp (fs i).continuous).measurable)))
    _ ((@lintegral_const_lt_top _ _ μ _ _ (@ennreal.coe_ne_top c)).ne) _,
  { simpa only [ennreal.coe_le_coe] using fs_le_const, },
  { simpa only [ennreal.tendsto_coe] using fs_lim, },
end

/-- A bounded convergence theorem for a finite measure:
If a sequence of bounded continuous non-negative functions are uniformly bounded by a constant
and tend pointwise to a limit, then their integrals (`measure_theory.lintegral`) against the finite
measure tend to the integral of the limit.

A related result with more general assumptions is
`measure_theory.finite_measure.tendsto_lintegral_nn_filter_of_le_const`.
-/
lemma tendsto_lintegral_nn_of_le_const (μ : finite_measure Ω) {fs : ℕ → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0}
  (fs_le_const : ∀ n ω, fs n ω ≤ c) {f : Ω → ℝ≥0}
  (fs_lim : ∀ ω, tendsto (λ n, fs n ω) at_top (𝓝 (f ω))) :
  tendsto (λ n, (∫⁻ ω, fs n ω ∂(μ : measure Ω))) at_top (𝓝 (∫⁻ ω, (f ω) ∂(μ : measure Ω))) :=
tendsto_lintegral_nn_filter_of_le_const μ
  (eventually_of_forall (λ n, eventually_of_forall (fs_le_const n))) (eventually_of_forall fs_lim)

/-- A bounded convergence theorem for a finite measure:
If bounded continuous non-negative functions are uniformly bounded by a constant and tend to a
limit, then their integrals against the finite measure tend to the integral of the limit.
This formulation assumes:
 * the functions tend to a limit along a countably generated filter;
 * the limit is in the almost everywhere sense;
 * boundedness holds almost everywhere;
 * integration is the pairing against non-negative continuous test functions
   (`measure_theory.finite_measure.test_against_nn`).

A related result using `measure_theory.lintegral` for integration is
`measure_theory.finite_measure.tendsto_lintegral_nn_filter_of_le_const`.
-/

/-- A bounded convergence theorem for a finite measure:
If a sequence of bounded continuous non-negative functions are uniformly bounded by a constant and
tend pointwise to a limit, then their integrals (`measure_theory.finite_measure.test_against_nn`)
against the finite measure tend to the integral of the limit.

Related results:
 * `measure_theory.finite_measure.tendsto_test_against_nn_filter_of_le_const`:
   more general assumptions
 * `measure_theory.finite_measure.tendsto_lintegral_nn_of_le_const`:
   using `measure_theory.lintegral` for integration.
-/
lemma tendsto_test_against_nn_of_le_const {μ : finite_measure Ω}
  {fs : ℕ → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0} (fs_le_const : ∀ n ω, fs n ω ≤ c) {f : Ω →ᵇ ℝ≥0}
  (fs_lim : ∀ ω, tendsto (λ n, fs n ω) at_top (𝓝 (f ω))) :
  tendsto (λ n, μ.test_against_nn (fs n)) at_top (𝓝 (μ.test_against_nn f)) :=
tendsto_test_against_nn_filter_of_le_const
  (eventually_of_forall (λ n, eventually_of_forall (fs_le_const n))) (eventually_of_forall fs_lim)

end finite_measure_bounded_convergence -- section

section finite_measure_convergence_by_bounded_continuous_functions
/-! ### Weak convergence of finite measures with bounded continuous real-valued functions

In this section we characterize the weak convergence of finite measures by the usual (defining)
condition that the integrals of all bounded continuous real-valued functions converge.
-/

variables {Ω : Type*} [measurable_space Ω] [topological_space Ω] [opens_measurable_space Ω]

lemma integrable_of_bounded_continuous_to_nnreal
  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ≥0) :
  integrable ((coe : ℝ≥0 → ℝ) ∘ ⇑f) μ :=
begin
  refine ⟨(nnreal.continuous_coe.comp f.continuous).measurable.ae_strongly_measurable, _⟩,
  simp only [has_finite_integral, nnreal.nnnorm_eq],
  exact lintegral_lt_top_of_bounded_continuous_to_nnreal _ f,
end

lemma integrable_of_bounded_continuous_to_real
  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ) :
  integrable ⇑f μ :=
begin
  refine ⟨f.continuous.measurable.ae_strongly_measurable, _⟩,
  have aux : (coe : ℝ≥0 → ℝ) ∘ ⇑f.nnnorm = (λ x, ‖f x‖),
  { ext ω,
    simp only [function.comp_app, bounded_continuous_function.nnnorm_coe_fun_eq, coe_nnnorm], },
  apply (has_finite_integral_iff_norm ⇑f).mpr,
  rw ← of_real_integral_eq_lintegral_of_real,
  { exact ennreal.of_real_lt_top, },
  { exact aux ▸ integrable_of_bounded_continuous_to_nnreal μ f.nnnorm, },
  { exact eventually_of_forall (λ ω, norm_nonneg (f ω)), },
end

lemma _root_.bounded_continuous_function.integral_eq_integral_nnreal_part_sub
  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ) :
  ∫ ω, f ω ∂μ = ∫ ω, f.nnreal_part ω ∂μ - ∫ ω, (-f).nnreal_part ω ∂μ :=
by simp only [f.self_eq_nnreal_part_sub_nnreal_part_neg,
              pi.sub_apply, integral_sub, integrable_of_bounded_continuous_to_nnreal]

lemma lintegral_lt_top_of_bounded_continuous_to_real
  {Ω : Type*} [measurable_space Ω] [topological_space Ω] (μ : measure Ω) [is_finite_measure μ]
  (f : Ω →ᵇ ℝ) :
  ∫⁻ ω, ennreal.of_real (f ω) ∂μ < ∞ :=
lintegral_lt_top_of_bounded_continuous_to_nnreal _ f.nnreal_part

theorem tendsto_of_forall_integral_tendsto
  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω}
  (h : (∀ (f : Ω →ᵇ ℝ),
       tendsto (λ i, (∫ x, (f x) ∂(μs i : measure Ω))) F (𝓝 ((∫ x, (f x) ∂(μ : measure Ω)))))) :
  tendsto μs F (𝓝 μ) :=
begin
  apply (@tendsto_iff_forall_lintegral_tendsto Ω _ _ _ γ F μs μ).mpr,
  intro f,
  have key := @ennreal.tendsto_to_real_iff _ F
              _ (λ i, (lintegral_lt_top_of_bounded_continuous_to_nnreal (μs i : measure Ω) f).ne)
              _ (lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f).ne,
  simp only [ennreal.of_real_coe_nnreal] at key,
  apply key.mp,
  have lip : lipschitz_with 1 (coe : ℝ≥0 → ℝ), from isometry_subtype_coe.lipschitz,
  set f₀ := bounded_continuous_function.comp _ lip f with def_f₀,
  have f₀_eq : ⇑f₀ = (coe : ℝ≥0 → ℝ) ∘ ⇑f, by refl,
  have f₀_nn : 0 ≤ ⇑f₀, from λ _, by simp only [f₀_eq, pi.zero_apply, nnreal.zero_le_coe],
  have f₀_ae_nn : 0 ≤ᵐ[(μ : measure Ω)] ⇑f₀, from eventually_of_forall f₀_nn,
  have f₀_ae_nns : ∀ i, 0 ≤ᵐ[(μs i : measure Ω)] ⇑f₀, from λ i, eventually_of_forall f₀_nn,
  have aux := integral_eq_lintegral_of_nonneg_ae f₀_ae_nn
              f₀.continuous.measurable.ae_strongly_measurable,
  have auxs := λ i, integral_eq_lintegral_of_nonneg_ae (f₀_ae_nns i)
              f₀.continuous.measurable.ae_strongly_measurable,
  simp only [f₀_eq, ennreal.of_real_coe_nnreal] at aux auxs,
  simpa only [←aux, ←auxs] using h f₀,
end

lemma _root_.bounded_continuous_function.nnreal.to_real_lintegral_eq_integral
  (f : Ω →ᵇ ℝ≥0) (μ : measure Ω) :
  (∫⁻ x, (f x : ℝ≥0∞) ∂μ).to_real = (∫ x, f x ∂μ) :=
begin
  rw integral_eq_lintegral_of_nonneg_ae _
     (nnreal.continuous_coe.comp f.continuous).measurable.ae_strongly_measurable,
  { simp only [ennreal.of_real_coe_nnreal], },
  { apply eventually_of_forall,
    simp only [pi.zero_apply, nnreal.zero_le_coe, implies_true_iff], },
end

/-- A characterization of weak convergence in terms of integrals of bounded continuous
real-valued functions. -/
theorem tendsto_iff_forall_integral_tendsto
  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
  tendsto μs F (𝓝 μ) ↔
  ∀ (f : Ω →ᵇ ℝ),
    tendsto (λ i, (∫ x, (f x) ∂(μs i : measure Ω))) F (𝓝 ((∫ x, (f x) ∂(μ : measure Ω)))) :=
begin
  refine ⟨_, tendsto_of_forall_integral_tendsto⟩,
  rw tendsto_iff_forall_lintegral_tendsto,
  intros h f,
  simp_rw bounded_continuous_function.integral_eq_integral_nnreal_part_sub,
  set f_pos := f.nnreal_part with def_f_pos,
  set f_neg := (-f).nnreal_part with def_f_neg,
  have tends_pos := (ennreal.tendsto_to_real
    ((lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f_pos).ne)).comp (h f_pos),
  have tends_neg := (ennreal.tendsto_to_real
    ((lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f_neg).ne)).comp (h f_neg),
  have aux : ∀ (g : Ω →ᵇ ℝ≥0), ennreal.to_real ∘ (λ (i : γ), ∫⁻ (x : Ω), ↑(g x) ∂(μs i : measure Ω))
         = λ (i : γ), (∫⁻ (x : Ω), ↑(g x) ∂(μs i : measure Ω)).to_real, from λ _, rfl,
  simp_rw [aux, bounded_continuous_function.nnreal.to_real_lintegral_eq_integral]
          at tends_pos tends_neg,
  exact tendsto.sub tends_pos tends_neg,
end

end finite_measure_convergence_by_bounded_continuous_functions -- section

end finite_measure -- namespace

end measure_theory -- namespace


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Kevin Buzzard, Jujian Zhang

From: https://github.com/leanprover-community/mathlib/blob/master/src/algebra/direct_sum/internal.lean
-/

import algebra.algebra.operations
import algebra.algebra.subalgebra.basic

import cicm2022.external.graded_algebra

/-!
# Internally graded rings and algebras
This module provides `gsemiring` and `gcomm_semiring` instances for a collection of subobjects `A`
when a `set_like.graded_monoid` instance is available:
* `set_like.gnon_unital_non_assoc_semiring`
* `set_like.gsemiring`
* `set_like.gcomm_semiring`
With these instances in place, it provides the bundled canonical maps out of a direct sum of
subobjects into their carrier type:
* `direct_sum.coe_ring_hom` (a `ring_hom` version of `direct_sum.coe_add_monoid_hom`)
* `direct_sum.coe_alg_hom` (an `alg_hom` version of `direct_sum.submodule_coe`)
Strictly the definitions in this file are not sufficient to fully define an "internal" direct sum;
to represent this case, `(h : direct_sum.is_internal A) [set_like.graded_monoid A]` is
needed. In the future there will likely be a data-carrying, constructive, typeclass version of
`direct_sum.is_internal` for providing an explicit decomposition function.
When `complete_lattice.independent (set.range A)` (a weaker condition than
`direct_sum.is_internal A`), these provide a grading of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.
## tags
internally graded ring
-/

open_locale direct_sum big_operators

variables {ι : Type*} {σ S R : Type*}

instance add_comm_monoid.of_submonoid_on_semiring [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) : ∀ i, add_comm_monoid (A i) :=
λ i, by apply_instance

instance add_comm_group.of_subgroup_on_semiring [ring R] [set_like σ R]
  [add_subgroup_class σ R] (A : ι → σ) : ∀ i, add_comm_group (A i) :=
λ i, by apply_instance

lemma set_like.has_graded_one.algebra_map_mem [has_zero ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.has_graded_one A] (s : S) : algebra_map S R s ∈ A 0 :=
begin
  rw algebra.algebra_map_eq_smul_one,
  exact ((A 0).smul_mem s set_like.has_graded_one.one_mem),
end

lemma set_like.has_graded_one.nat_cast_mem [has_zero ι] [add_monoid_with_one R]
  [set_like σ R] [add_submonoid_class σ R] (A : ι → σ) [set_like.has_graded_one A] (n : ℕ) :
  (n : R) ∈ A 0:=
begin
  induction n,
  { rw nat.cast_zero,
    exact zero_mem (A 0), },
  { rw nat.cast_succ,
    exact add_mem n_ih set_like.has_graded_one.one_mem, },
end

lemma set_like.has_graded_one.int_cast_mem [has_zero ι] [add_group_with_one R]
  [set_like σ R] [add_subgroup_class σ R] (A : ι → σ) [set_like.has_graded_one A] (z : ℤ) :
  (z : R) ∈ A 0:=
begin
  induction z,
  { rw int.cast_of_nat,
    exact set_like.has_graded_one.nat_cast_mem _ _, },
  { rw int.cast_neg_succ_of_nat,
    exact neg_mem (set_like.has_graded_one.nat_cast_mem _ _), },
end

section direct_sum
variables [decidable_eq ι]

/-! #### From `add_submonoid`s and `add_subgroup`s -/

namespace set_like

/-- Build a `gnon_unital_non_assoc_semiring` instance for a collection of additive submonoids. -/
instance gnon_unital_non_assoc_semiring [has_add ι] [non_unital_non_assoc_semiring R]
  [set_like σ R] [add_submonoid_class σ R]
  (A : ι → σ) [set_like.has_graded_mul A] :
  direct_sum.gnon_unital_non_assoc_semiring (λ i, A i) :=
{ mul_zero := λ i j _, subtype.ext (mul_zero _),
  zero_mul := λ i j _, subtype.ext (zero_mul _),
  mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _),
  add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _),
  ..set_like.ghas_mul A }

/-- Build a `gsemiring` instance for a collection of additive submonoids. -/
instance gsemiring [add_monoid ι] [semiring R] [set_like σ R] [add_submonoid_class σ R]
  (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gsemiring (λ i, A i) :=
{ mul_zero := λ i j _, subtype.ext (mul_zero _),
  zero_mul := λ i j _, subtype.ext (zero_mul _),
  mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _),
  add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _),
  nat_cast := λ n, ⟨n, set_like.has_graded_one.nat_cast_mem _ _⟩,
  nat_cast_zero := subtype.ext nat.cast_zero,
  nat_cast_succ := λ n, subtype.ext (nat.cast_succ n),
  ..set_like.gmonoid A }

/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/
instance gcomm_semiring [add_comm_monoid ι] [comm_semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gcomm_semiring (λ i, A i) :=
{ ..set_like.gcomm_monoid A,
  ..set_like.gsemiring A, }

/-- Build a `gring` instance for a collection of additive subgroups. -/
instance gring [add_monoid ι] [ring R] [set_like σ R] [add_subgroup_class σ R]
  (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gring (λ i, A i) :=
{ int_cast := λ z, ⟨z, set_like.has_graded_one.int_cast_mem _ _⟩,
  int_cast_of_nat := λ n, subtype.ext $ int.cast_of_nat _,
  int_cast_neg_succ_of_nat := λ n, subtype.ext $ int.cast_neg_succ_of_nat n,
  ..set_like.gsemiring A }

/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/
instance gcomm_ring [add_comm_monoid ι] [comm_ring R] [set_like σ R]
  [add_subgroup_class σ R] (A : ι → σ) [set_like.graded_monoid A] :
  direct_sum.gcomm_ring (λ i, A i) :=
{ ..set_like.gcomm_monoid A,
  ..set_like.gring A, }

end set_like

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
def direct_sum.coe_ring_hom [add_monoid ι] [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A] : (⨁ i, A i) →+* R :=
direct_sum.to_semiring (λ i, add_submonoid_class.subtype (A i)) rfl (λ _ _ _ _, rfl)

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
@[simp] lemma direct_sum.coe_ring_hom_of [add_monoid ι] [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.coe_ring_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ _ _ _ _

lemma direct_sum.coe_mul_apply [add_monoid ι] [semiring R] [set_like σ R]
  [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A]
  [Π (i : ι) (x : A i), decidable (x ≠ 0)] (r r' : ⨁ i, A i) (i : ι) :
  ((r * r') i : R) =
    ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support),
      r ij.1 * r' ij.2 :=
begin
  rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply,
    add_submonoid_class.coe_finset_sum],
  simp_rw [direct_sum.coe_of_apply, ←finset.sum_filter, set_like.coe_ghas_mul],
end

/-! #### From `submodule`s -/

namespace submodule

/-- Build a `galgebra` instance for a collection of `submodule`s. -/
instance galgebra [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] :
  direct_sum.galgebra S (λ i, A i) :=
{ to_fun := ((algebra.linear_map S R).cod_restrict (A 0) $
    set_like.has_graded_one.algebra_map_mem A).to_add_monoid_hom,
  map_one := subtype.ext $ by exact (algebra_map S R).map_one,
  map_mul := λ x y, sigma.subtype_ext (add_zero 0).symm $ (algebra_map S R).map_mul _ _,
  commutes := λ r ⟨i, xi⟩,
    sigma.subtype_ext ((zero_add i).trans (add_zero i).symm) $ algebra.commutes _ _,
  smul_def := λ r ⟨i, xi⟩, sigma.subtype_ext (zero_add i).symm $ algebra.smul_def _ _ }

@[simp] lemma set_like.coe_galgebra_to_fun [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] (s : S) :
    ↑(@direct_sum.galgebra.to_fun _ S (λ i, A i) _ _ _ _ _ _ _ s) = (algebra_map S R s : R) := rfl

/-- A direct sum of powers of a submodule of an algebra has a multiplicative structure. -/
instance nat_power_graded_monoid
  [comm_semiring S] [semiring R] [algebra S R] (p : submodule S R) :
  set_like.graded_monoid (λ i : ℕ, p ^ i) :=
{ one_mem := by { rw [←one_le, pow_zero], exact le_rfl },
  mul_mem := λ i j p q hp hq, by { rw pow_add, exact submodule.mul_mem_mul hp hq } }

end submodule

/-- The canonical algebra isomorphism between `⨁ i, A i` and `R`. -/
def direct_sum.coe_alg_hom [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] : (⨁ i, A i) →ₐ[S] R :=
direct_sum.to_algebra S _ (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl) (λ _, rfl)

/-- The supremum of submodules that form a graded monoid is a subalgebra, and equal to the range of
`direct_sum.coe_alg_hom`. -/
lemma submodule.supr_eq_to_submodule_range [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R] (A : ι → submodule S R) [set_like.graded_monoid A] :
  (⨆ i, A i) = (direct_sum.coe_alg_hom A).range.to_submodule :=
(submodule.supr_eq_range_dfinsupp_lsum A).trans $ set_like.coe_injective rfl

@[simp] lemma direct_sum.coe_alg_hom_of [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.coe_alg_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ rfl (λ _ _ _ _, rfl) _ _

end direct_sum

section homogeneous_element

lemma set_like.is_homogeneous_zero_submodule [has_zero ι]
  [semiring S] [add_comm_monoid R] [module S R]
  (A : ι → submodule S R) : set_like.is_homogeneous A (0 : R) :=
⟨0, submodule.zero_mem _⟩

lemma set_like.is_homogeneous.smul [comm_semiring S] [semiring R] [algebra S R]
  {A : ι → submodule S R} {s : S}
  {r : R} (hr : set_like.is_homogeneous A r) : set_like.is_homogeneous A (s • r) :=
let ⟨i, hi⟩ := hr in ⟨i, submodule.smul_mem _ _ hi⟩

end homogeneous_element


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

/-!
# 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_refl _, },
  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_refl _, },
  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)
                                               (set.prod ((base_set i) ∩ (base_set j)) univ))
(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.prod s, (continuous_on_open_iff
        (Z.local_triv_at b).open_source).mp (Z.local_triv_at b).continuous_to_fun _
        (is_open.prod (Z.local_triv_at b).open_base_set 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


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

! This file was ported from Lean 3 source module category_theory.monoidal.End
! leanprover-community/mathlib commit 85075bccb68ab7fa49fb05db816233fb790e4fe9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Monoidal.Functor

/-!
# Endofunctors as a monoidal category.

We give the monoidal category structure on `C ⥤ C`,
and show that when `C` itself is monoidal, it embeds via a monoidal functor into `C ⥤ C`.

## TODO

Can we use this to show coherence results, e.g. a cheap proof that `λ_ (𝟙_ C) = ρ_ (𝟙_ C)`?
I suspect this is harder than is usually made out.
-/

universe v u

namespace CategoryTheory

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

/-- The category of endofunctors of any category is a monoidal category,
with tensor product given by composition of functors
(and horizontal composition of natural transformations).
-/
def endofunctorMonoidalCategory : MonoidalCategory (C ⥤ C) where
  tensorObj F G := F ⋙ G
  tensorHom α β := α ◫ β
  tensorUnit' := 𝟭 C
  associator F G H := Functor.associator F G H
  leftUnitor F := Functor.leftUnitor F
  rightUnitor F := Functor.rightUnitor F
#align category_theory.endofunctor_monoidal_category CategoryTheory.endofunctorMonoidalCategory

open CategoryTheory.MonoidalCategory

attribute [local instance] endofunctorMonoidalCategory

-- porting note: used `dsimp [endofunctorMonoidalCategory]` when necessary instead
-- attribute [local reducible] endofunctorMonoidalCategory

/-- Tensoring on the right gives a monoidal functor from `C` into endofunctors of `C`.
-/
@[simps!]
def tensoringRightMonoidal [MonoidalCategory.{v} C] : MonoidalFunctor C (C ⥤ C) :=
  {-- We could avoid needing to do this explicitly by
      -- constructing a partially applied analogue of `associatorNatIso`.
      tensoringRight C with
    ε := (rightUnitorNatIso C).inv
    μ := fun X Y =>
      { app := fun Z => (α_ Z X Y).hom
        naturality := fun Z Z' f => by
          dsimp [endofunctorMonoidalCategory]
          rw [associator_naturality]
          simp }
    μ_natural := fun f g => by
      ext Z
      dsimp [endofunctorMonoidalCategory]
      simp only [← id_tensor_comp_tensor_id g f, id_tensor_comp, ← tensor_id, Category.assoc,
        associator_naturality, associator_naturality_assoc]
    associativity := fun X Y Z => by
      ext W
      dsimp [endofunctorMonoidalCategory]
      simp [pentagon]
    left_unitality := fun X => by
      ext Y
      dsimp [endofunctorMonoidalCategory]
      rw [Category.id_comp, triangle, ← tensor_comp]
      aesop_cat
    right_unitality := fun X => by
      ext Y; dsimp [endofunctorMonoidalCategory]
      rw [tensor_id, Category.comp_id, rightUnitor_tensor_inv, Category.assoc,
        Iso.inv_hom_id_assoc, ← id_tensor_comp, Iso.inv_hom_id, tensor_id]
    ε_isIso := by infer_instance
    μ_isIso := fun X Y =>
      ⟨⟨{   app := fun Z => (α_ Z X Y).inv
            naturality := fun Z Z' f => by
              dsimp [endofunctorMonoidalCategory]
              rw [← associator_inv_naturality]
              simp },
          by aesop_cat⟩⟩ }
#align category_theory.tensoring_right_monoidal CategoryTheory.tensoringRightMonoidal

variable {C}

variable {M : Type _} [Category M] [MonoidalCategory M] (F : MonoidalFunctor M (C ⥤ C))

@[reassoc (attr := simp)]
theorem μ_hom_inv_app (i j : M) (X : C) : (F.μ i j).app X ≫ (F.μIso i j).inv.app X = 𝟙 _ :=
  (F.μIso i j).hom_inv_id_app X
#align category_theory.μ_hom_inv_app CategoryTheory.μ_hom_inv_app

@[reassoc (attr := simp)]
theorem μ_inv_hom_app (i j : M) (X : C) : (F.μIso i j).inv.app X ≫ (F.μ i j).app X = 𝟙 _ :=
  (F.μIso i j).inv_hom_id_app X
#align category_theory.μ_inv_hom_app CategoryTheory.μ_inv_hom_app

@[reassoc (attr := simp)]
theorem ε_hom_inv_app (X : C) : F.ε.app X ≫ F.εIso.inv.app X = 𝟙 _ :=
  F.εIso.hom_inv_id_app X
#align category_theory.ε_hom_inv_app CategoryTheory.ε_hom_inv_app

@[reassoc (attr := simp)]
theorem ε_inv_hom_app (X : C) : F.εIso.inv.app X ≫ F.ε.app X = 𝟙 _ :=
  F.εIso.inv_hom_id_app X
#align category_theory.ε_inv_hom_app CategoryTheory.ε_inv_hom_app

@[reassoc (attr := simp)]
theorem ε_naturality {X Y : C} (f : X ⟶ Y) : F.ε.app X ≫ (F.obj (𝟙_ M)).map f = f ≫ F.ε.app Y :=
  (F.ε.naturality f).symm
#align category_theory.ε_naturality CategoryTheory.ε_naturality

@[reassoc (attr := simp)]
theorem ε_inv_naturality {X Y : C} (f : X ⟶ Y) :
    (MonoidalFunctor.εIso F).inv.app X ≫ (𝟙_ (C ⥤ C)).map f = F.εIso.inv.app X ≫ f := by
  aesop_cat
#align category_theory.ε_inv_naturality CategoryTheory.ε_inv_naturality

@[reassoc (attr := simp)]
theorem μ_naturality {m n : M} {X Y : C} (f : X ⟶ Y) :
    (F.obj n).map ((F.obj m).map f) ≫ (F.μ m n).app Y = (F.μ m n).app X ≫ (F.obj _).map f :=
  (F.toLaxMonoidalFunctor.μ m n).naturality f
#align category_theory.μ_naturality CategoryTheory.μ_naturality

-- This is a simp lemma in the reverse direction via `NatTrans.naturality`.
@[reassoc]
theorem μ_inv_naturality {m n : M} {X Y : C} (f : X ⟶ Y) :
    (F.μIso m n).inv.app X ≫ (F.obj n).map ((F.obj m).map f) =
      (F.obj _).map f ≫ (F.μIso m n).inv.app Y :=
  ((F.μIso m n).inv.naturality f).symm
#align category_theory.μ_inv_naturality CategoryTheory.μ_inv_naturality

-- This is not a simp lemma since it could be proved by the lemmas later.
@[reassoc]

@[reassoc (attr := simp)]
theorem μ_naturalityₗ {m n m' : M} (f : m ⟶ m') (X : C) :
    (F.obj n).map ((F.map f).app X) ≫ (F.μ m' n).app X =
      (F.μ m n).app X ≫ (F.map (f ⊗ 𝟙 n)).app X := by
  rw [← μ_naturality₂ F f (𝟙 n) X]
  simp
#align category_theory.μ_naturalityₗ CategoryTheory.μ_naturalityₗ

@[reassoc (attr := simp)]
theorem μ_naturalityᵣ {m n n' : M} (g : n ⟶ n') (X : C) :
    (F.map g).app ((F.obj m).obj X) ≫ (F.μ m n').app X =
      (F.μ m n).app X ≫ (F.map (𝟙 m ⊗ g)).app X := by
  rw [← μ_naturality₂ F (𝟙 m) g X]
  simp
#align category_theory.μ_naturalityᵣ CategoryTheory.μ_naturalityᵣ

@[reassoc (attr := simp)]
theorem μ_inv_naturalityₗ {m n m' : M} (f : m ⟶ m') (X : C) :
    (F.μIso m n).inv.app X ≫ (F.obj n).map ((F.map f).app X) =
      (F.map (f ⊗ 𝟙 n)).app X ≫ (F.μIso m' n).inv.app X := by
  rw [← IsIso.comp_inv_eq, Category.assoc, ← IsIso.eq_inv_comp]
  simp
#align category_theory.μ_inv_naturalityₗ CategoryTheory.μ_inv_naturalityₗ

@[reassoc (attr := simp)]
theorem μ_inv_naturalityᵣ {m n n' : M} (g : n ⟶ n') (X : C) :
    (F.μIso m n).inv.app X ≫ (F.map g).app ((F.obj m).obj X) =
      (F.map (𝟙 m ⊗ g)).app X ≫ (F.μIso m n').inv.app X := by
  rw [← IsIso.comp_inv_eq, Category.assoc, ← IsIso.eq_inv_comp]
  simp
#align category_theory.μ_inv_naturalityᵣ CategoryTheory.μ_inv_naturalityᵣ

@[reassoc]
theorem left_unitality_app (n : M) (X : C) :
    (F.obj n).map (F.ε.app X) ≫ (F.μ (𝟙_ M) n).app X ≫ (F.map (λ_ n).hom).app X = 𝟙 _ := by
  have := congr_app (F.toLaxMonoidalFunctor.left_unitality n) X
  dsimp [endofunctorMonoidalCategory] at this
  simpa using this.symm
#align category_theory.left_unitality_app CategoryTheory.left_unitality_app

-- porting note: linter claims `simp can prove it`, but cnot
@[reassoc (attr := simp, nolint simpNF)]
theorem obj_ε_app (n : M) (X : C) :
    (F.obj n).map (F.ε.app X) = (F.map (λ_ n).inv).app X ≫ (F.μIso (𝟙_ M) n).inv.app X := by
  refine' Eq.trans _ (Category.id_comp _)
  rw [← Category.assoc, ← IsIso.comp_inv_eq, ← IsIso.comp_inv_eq, Category.assoc]
  convert left_unitality_app F n X
  · simp
  · simp
#align category_theory.obj_ε_app CategoryTheory.obj_ε_app

-- porting note: linter claims `simp can prove it`, but cnot
@[reassoc (attr := simp, nolint simpNF)]
theorem obj_ε_inv_app (n : M) (X : C) :
    (F.obj n).map (F.εIso.inv.app X) = (F.μ (𝟙_ M) n).app X ≫ (F.map (λ_ n).hom).app X := by
  rw [← cancel_mono ((F.obj n).map (F.ε.app X)), ← Functor.map_comp]
  simp
  rfl
#align category_theory.obj_ε_inv_app CategoryTheory.obj_ε_inv_app

@[reassoc]
theorem right_unitality_app (n : M) (X : C) :
    F.ε.app ((F.obj n).obj X) ≫ (F.μ n (𝟙_ M)).app X ≫ (F.map (ρ_ n).hom).app X = 𝟙 _ := by
  have := congr_app (F.toLaxMonoidalFunctor.right_unitality n) X
  dsimp [endofunctorMonoidalCategory] at this
  simpa using this.symm
#align category_theory.right_unitality_app CategoryTheory.right_unitality_app

@[simp]
theorem ε_app_obj (n : M) (X : C) :
    F.ε.app ((F.obj n).obj X) = (F.map (ρ_ n).inv).app X ≫ (F.μIso n (𝟙_ M)).inv.app X := by
  refine' Eq.trans _ (Category.id_comp _)
  rw [← Category.assoc, ← IsIso.comp_inv_eq, ← IsIso.comp_inv_eq, Category.assoc]
  convert right_unitality_app F n X using 1
  simp
#align category_theory.ε_app_obj CategoryTheory.ε_app_obj

@[simp]
theorem ε_inv_app_obj (n : M) (X : C) :
    F.εIso.inv.app ((F.obj n).obj X) = (F.μ n (𝟙_ M)).app X ≫ (F.map (ρ_ n).hom).app X := by
  rw [← cancel_mono (F.ε.app ((F.obj n).obj X)), ε_inv_hom_app]
  simp
  rfl
#align category_theory.ε_inv_app_obj CategoryTheory.ε_inv_app_obj

@[reassoc]
theorem associativity_app (m₁ m₂ m₃ : M) (X : C) :
    (F.obj m₃).map ((F.μ m₁ m₂).app X) ≫
        (F.μ (m₁ ⊗ m₂) m₃).app X ≫ (F.map (α_ m₁ m₂ m₃).hom).app X =
      (F.μ m₂ m₃).app ((F.obj m₁).obj X) ≫ (F.μ m₁ (m₂ ⊗ m₃)).app X := by
  have := congr_app (F.toLaxMonoidalFunctor.associativity m₁ m₂ m₃) X
  dsimp [endofunctorMonoidalCategory] at this
  simpa using this
#align category_theory.associativity_app CategoryTheory.associativity_app

-- porting note: linter claims `simp can prove it`, but cnot
@[reassoc (attr := simp, nolint simpNF)]
theorem obj_μ_app (m₁ m₂ m₃ : M) (X : C) :
    (F.obj m₃).map ((F.μ m₁ m₂).app X) =
      (F.μ m₂ m₃).app ((F.obj m₁).obj X) ≫
        (F.μ m₁ (m₂ ⊗ m₃)).app X ≫
          (F.map (α_ m₁ m₂ m₃).inv).app X ≫ (F.μIso (m₁ ⊗ m₂) m₃).inv.app X := by
  rw [← associativity_app_assoc]
  dsimp [endofunctorMonoidalCategory]
  simp
  dsimp [endofunctorMonoidalCategory]
  simp
#align category_theory.obj_μ_app CategoryTheory.obj_μ_app

-- porting note: linter claims `simp can prove it`, but cnot
@[reassoc (attr := simp, nolint simpNF)]
theorem obj_μ_inv_app (m₁ m₂ m₃ : M) (X : C) :
    (F.obj m₃).map ((F.μIso m₁ m₂).inv.app X) =
      (F.μ (m₁ ⊗ m₂) m₃).app X ≫
        (F.map (α_ m₁ m₂ m₃).hom).app X ≫
          (F.μIso m₁ (m₂ ⊗ m₃)).inv.app X ≫ (F.μIso m₂ m₃).inv.app ((F.obj m₁).obj X) := by
  rw [← IsIso.inv_eq_inv]
  convert obj_μ_app F m₁ m₂ m₃ X using 1
  · refine' IsIso.inv_eq_of_hom_inv_id _
    rw [← Functor.map_comp]
    simp
  · simp only [MonoidalFunctor.μIso_hom, Category.assoc, NatIso.inv_inv_app, IsIso.inv_comp]
    congr
    · refine' IsIso.inv_eq_of_hom_inv_id _
      simp
    · refine' IsIso.inv_eq_of_hom_inv_id _
      simp
      rfl
#align category_theory.obj_μ_inv_app CategoryTheory.obj_μ_inv_app

@[reassoc (attr := simp)]
theorem obj_zero_map_μ_app {m : M} {X Y : C} (f : X ⟶ (F.obj m).obj Y) :
    (F.obj (𝟙_ M)).map f ≫ (F.μ m (𝟙_ M)).app _ =
    F.εIso.inv.app _ ≫ f ≫ (F.map (ρ_ m).inv).app _ := by
  rw [← IsIso.inv_comp_eq, ← IsIso.comp_inv_eq]
  simp
#align category_theory.obj_zero_map_μ_app CategoryTheory.obj_zero_map_μ_app

@[simp]
theorem obj_μ_zero_app (m₁ m₂ : M) (X : C) :
   (F.μ (𝟙_ M) m₂).app ((F.obj m₁).obj X) ≫ (F.μ m₁ (𝟙_ M ⊗ m₂)).app X ≫
   (F.map (α_ m₁ (𝟙_ M) m₂).inv).app X ≫ (F.μIso (m₁ ⊗ 𝟙_ M) m₂).inv.app X =
      (F.μ (𝟙_ M) m₂).app ((F.obj m₁).obj X) ≫
        (F.map (λ_ m₂).hom).app ((F.obj m₁).obj X) ≫ (F.obj m₂).map ((F.map (ρ_ m₁).inv).app X) :=
  by
  rw [← obj_ε_inv_app_assoc, ← Functor.map_comp]
  congr ; simp
#align category_theory.obj_μ_zero_app CategoryTheory.obj_μ_zero_app

/-- If `m ⊗ n ≅ 𝟙_M`, then `F.obj m` is a left inverse of `F.obj n`. -/
@[simps!]
noncomputable def unitOfTensorIsoUnit (m n : M) (h : m ⊗ n ≅ 𝟙_ M) : F.obj m ⋙ F.obj n ≅ 𝟭 C :=
  F.μIso m n ≪≫ F.toFunctor.mapIso h ≪≫ F.εIso.symm
#align category_theory.unit_of_tensor_iso_unit CategoryTheory.unitOfTensorIsoUnit

/-- If `m ⊗ n ≅ 𝟙_M` and `n ⊗ m ≅ 𝟙_M` (subject to some commuting constraints),
  then `F.obj m` and `F.obj n` forms a self-equivalence of `C`. -/
@[simps]
noncomputable def equivOfTensorIsoUnit (m n : M) (h₁ : m ⊗ n ≅ 𝟙_ M) (h₂ : n ⊗ m ≅ 𝟙_ M)
    (H : (h₁.hom ⊗ 𝟙 m) ≫ (λ_ m).hom = (α_ m n m).hom ≫ (𝟙 m ⊗ h₂.hom) ≫ (ρ_ m).hom) : C ≌ C
    where
  functor := F.obj m
  inverse := F.obj n
  unitIso := (unitOfTensorIsoUnit F m n h₁).symm
  counitIso := unitOfTensorIsoUnit F n m h₂
  functor_unitIso_comp := by
    intro X
    dsimp
    simp only [μ_naturalityᵣ_assoc, μ_naturalityₗ_assoc, ε_inv_app_obj, Category.assoc,
      obj_μ_inv_app, Functor.map_comp, μ_inv_hom_app_assoc, obj_ε_app,
      unitOfTensorIsoUnit_inv_app]
    simp [← NatTrans.comp_app, ← F.toFunctor.map_comp, ← H, -Functor.map_comp]
#align category_theory.equiv_of_tensor_iso_unit CategoryTheory.equivOfTensorIsoUnit

end CategoryTheory


import .love08_operational_semantics_demo

/- # LoVe Demo 10: Denotational Semantics

We review a third way to specify the semantics of a programming language:
denotational semantics. Denotational semantics attempt to directly specify the
meaning of programs.

If operational semantics is an idealized interpreter and Hoare logic is an
idealized verifier, then denotational semantics is an idealized compiler.-/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Compositionality

A __denotational semantics__ defines the meaning of each program as a
mathematical object:

    `⟦ ⟧ : syntax → semantics`

A key property of denotational semantics is __compositionality__: The meaning of
a compound statement should be defined in terms of the meaning of its
components. This disqualifies

    `⟦S⟧ = {st | (S, prod.fst st) ⟹ prod.snd st}`

i.e.

    `⟦S⟧ = {(s, t) | (S, s) ⟹ t}`

because operational semantics are not compositional.

In short, we want

    `⟦S ; T⟧              = … ⟦S⟧ … ⟦T⟧ …`
    `⟦if b then S else T⟧ = … ⟦S⟧ … ⟦T⟧ …`
    `⟦while b do S⟧       = … ⟦S⟧ …`

An evaluation function on arithmetic expressions

    `eval : aexp → ((string → ℤ) → ℤ)`

is a denotational semantics. We want the same for imperative programs.

## A Relational Denotational Semantics

We can represent the semantics of an imperative program as a function from
initial state to final state or more generally as a relation between initial
state and final state: `set (state × state)`.

For `skip`, `:=`, `;`, and `if then else`, the denotational semantics is
easy: -/

namespace sorry_defs

def denote : stmt → set (state × state)
| stmt.skip         := Id
| (stmt.assign n a) :=
  {st | prod.snd st = (prod.fst st){n ↦ a (prod.fst st)}}
| (stmt.seq S T)    := denote S ◯ denote T
| (stmt.ite b S T)  :=
  (denote S ⇃ b) ∪ (denote T ⇃ (λs, ¬ b s))
| (stmt.while b S)  := sorry

end sorry_defs

/- We write `⟦S⟧` for `denote S`. For `while`, we would like to write

    `((denote S ◯ denote (stmt.while b S)) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s))`

but this is ill-founded due to the recursive call on `stmt.while b S`.

What we are looking for is an `X` such that

    `X = ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s))`

In other words, we are looking for a fixpoint.

Most of this lecture is concerned with building a least fixpoint operator
`lfp` that will allow us to define the `while` case as well:

    `lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s)))`

## Fixpoints

A __fixpoint__ (or fixed point) of `f` is a solution for `X` in the equation

    `X = f X`

In general, fixpoints may not exist at all (e.g., `f := nat.succ`), or there may
be several fixpoints (e.g., `f := id`). But under some conditions on `f`, a
unique __least fixpoint__ and a unique __greatest fixpoint__ are guaranteed to
exist.

Consider this __fixpoint equation__:

    `X = (λ(p : ℕ → Prop) (n : ℕ), n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ p m) X`
      `= (λn : ℕ, n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ X m)`

where `X : ℕ → Prop` and
`f := (λ(p : ℕ → Prop) (n : ℕ), n = 0 ∨ ∃m : ℕ, n = m + 2 ∧ p m)`.

The above example admits only one fixpoint. The fixpoint equation uniquely
specifies `X` as the set of even numbers.

In general, the least and greatest fixpoint may be different:

    `X = X`

Here, the least fixpoint is `(λ_, False)` and the greatest fixpoint is
`(λ_, True)`. Conventionally, `False < True`, and thus
`(λ_, False) < (λ_, True)`. Similarly, `∅ < @set.univ α` (assuming `α` is
inhabited).

For the semantics of programming languages:

* `X` will have type `set (state × state)` (which is isomorphic to
  `state → state → Prop`), representing relations between states;

* `f` will correspond to either taking one extra iteration of the loop (if the
  condition `b` is true) or the identity (if `b` is false).

Kleene's fixpoint theorem:

    `f^0(∅) ∪ f^1(∅) ∪ f^2(∅) ∪ ⋯ = lfp f`

The least fixpoint corresponds to finite executions of a program, which is all
we care about.

**Key observation**:

    Inductive predicates correspond to least fixpoints, but they are built into
    Lean's logic (the calculus of inductive constructions).

## Monotone Functions

Let `α` and `β` be types with partial order `≤`. A function `f : α → β` is
__monotone__ if

    `a ≤ b → f a ≤ f b`   for all `a`, `b`

Many operations on sets (e.g., `∪`), relations (e.g., `◯`), and functions
(e.g., `λx, x`, `λ_, k`, `∘`) are monotone or preserve monotonicity.

All monotone functions `f : set α → set α` admit least and greatest fixpoints.

**Example of a nonmonotone function**:

    `f A = (if A = ∅ then set.univ else ∅)`

Assuming `α` is inhabited, we have `∅ ⊆ set.univ`, but
`f ∅ = set.univ ⊈ ∅ = f set.univ`. -/

def monotone {α β : Type} [partial_order α] [partial_order β]
  (f : α → β) : Prop :=
∀a₁ a₂, a₁ ≤ a₂ → f a₁ ≤ f a₂

lemma monotone_id {α : Type} [partial_order α] :
  monotone (λa : α, a) :=
begin
  intros a₁ a₂ ha,
  exact ha
end

lemma monotone_const {α β : Type} [partial_order α]
    [partial_order β] (b : β) :
  monotone (λ_ : α, b) :=
begin
  intros a₁ a₂ ha,
  exact le_refl b
end

lemma monotone_union {α β : Type} [partial_order α]
    (f g : α → set β) (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ∪ g a) :=
begin
  intros a₁ a₂ ha b hb,
  cases' hb,
  { exact or.intro_left _ (hf a₁ a₂ ha h) },
  { exact or.intro_right _ (hg a₁ a₂ ha h) }
end

/- We will prove the following two lemmas in the exercise. -/

namespace sorry_lemmas

lemma monotone_comp {α β : Type} [partial_order α]
    (f g : α → set (β × β)) (hf : monotone f)
    (hg : monotone g) :
  monotone (λa, f a ◯ g a) :=
sorry

lemma monotone_restrict {α β : Type} [partial_order α]
    (f : α → set (β × β)) (p : β → Prop) (hf : monotone f) :
  monotone (λa, f a ⇃ p) :=
sorry

end sorry_lemmas

/- ## Complete Lattices

To define the least fixpoint on sets, we need `⊆` and `⋂`. Complete lattices
capture this concept abstractly. A __complete lattice__ is an ordered type `α`
for which each set of type `set α` has an infimum.

More precisely, A complete lattice consists of

* a partial order `≤ : α → α → Prop` (i.e., a reflexive, transitive, and
  antisymmetric binary predicate);

* an operator `Inf : set α → α`, called __infimum__.

Moreover, `Inf A` must satisfy these two properties:

* `Inf A` is a lower bound of `A`: `Inf A ≤ b` for all `b ∈ A`;

* `Inf A` is a greatest lower bound: `b ≤ Inf A` for all `b` such that
  `∀a, a ∈ A → b ≤ a`.

**Warning:** `Inf A` is not necessarily an element of `A`.

Examples:

* `set α` is an instance w.r.t. `⊆` and `⋂` for all `α`;
* `Prop` is an instance w.r.t. `→` and `∀` (`Inf A := ∀a ∈ A, a`);
* `enat := ℕ ∪ {∞}`;
* `ereal := ℝ ∪ {- ∞, ∞}`;
* `β → α` if `α` is a complete lattice;
* `α × β` if `α`, `β` are complete lattices.

Finite example (with apologies for the ASCII art):

                Z            Inf {}           = ?
              /   \          Inf {Z}          = ?
             A     B         Inf {A, B}       = ?
              \   /          Inf {Z, A}       = ?
                Y            Inf {Z, A, B, Y} = ?

Nonexamples:

* `ℕ`, `ℤ`, `ℚ`, `ℝ`: no infimum for `∅`, `Inf ℕ`, etc.
* `erat := ℚ ∪ {- ∞, ∞}`: `Inf {q | 2 < q * q} = sqrt 2` is not in `erat`. -/

@[class] structure complete_lattice (α : Type)
  extends partial_order α : Type :=
(Inf    : set α → α)
(Inf_le : ∀A b, b ∈ A → Inf A ≤ b)
(le_Inf : ∀A b, (∀a, a ∈ A → b ≤ a) → b ≤ Inf A)

/- For sets: -/

@[instance] def set.complete_lattice {α : Type} :
  complete_lattice (set α) :=
{ le          := (⊆),
  le_refl     := by tautology,
  le_trans    := by tautology,
  le_antisymm :=
    begin
      intros A B hAB hBA,
      apply set.ext,
      tautology
    end,
  Inf         := λ𝒜, {a | ∀A, A ∈ 𝒜 → a ∈ A},
  Inf_le      := by tautology,
  le_Inf      := by tautology }

/- ## Least Fixpoint -/

def lfp {α : Type} [complete_lattice α] (f : α → α) : α :=
complete_lattice.Inf ({a | f a ≤ a})

lemma lfp_le {α : Type} [complete_lattice α] (f : α → α)
    (a : α) (h : f a ≤ a) :
  lfp f ≤ a :=
complete_lattice.Inf_le _ _ h

lemma le_lfp {α : Type} [complete_lattice α] (f : α → α)
    (a : α) (h : ∀a', f a' ≤ a' → a ≤ a') :
  a ≤ lfp f :=
complete_lattice.le_Inf _ _ h

/- **Knaster-Tarski theorem:** For any monotone function `f`:

* `lfp f` is a fixpoint: `lfp f = f (lfp f)` (lemma `lfp_eq`);
* `lfp f` is smaller than any other fixpoint: `X = f X → lfp f ≤ X`. -/

lemma lfp_eq {α : Type} [complete_lattice α] (f : α → α)
    (hf : monotone f) :
  lfp f = f (lfp f) :=
begin
  have h : f (lfp f) ≤ lfp f :=
    begin
      apply le_lfp,
      intros a' ha',
      apply @le_trans _ _ _ (f a'),
      { apply hf,
        apply lfp_le,
        assumption },
      { assumption }
    end,
  apply le_antisymm,
  { apply lfp_le,
    apply hf,
    assumption },
  { assumption }
end

/- ## A Relational Denotational Semantics, Continued -/

def denote : stmt → set (state × state)
| stmt.skip         := Id
| (stmt.assign x a) :=
  {st | prod.snd st = (prod.fst st){x ↦ a (prod.fst st)}}
| (stmt.seq S T)    := denote S ◯ denote T
| (stmt.ite b S T)  :=
  (denote S ⇃ b) ∪ (denote T ⇃ (λs, ¬ b s))
| (stmt.while b S)  :=
  lfp (λX, ((denote S ◯ X) ⇃ b) ∪ (Id ⇃ (λs, ¬ b s)))

notation `⟦` S `⟧`:= denote S

/- ## Application to Program Equivalence

Based on the denotational semantics, we introduce the notion of program
equivalence: `S₁ ~ S₂`. (Compare with exercise 8.) -/

def denote_equiv (S₁ S₂ : stmt) : Prop :=
⟦S₁⟧ = ⟦S₂⟧

infix ` ~ ` := denote_equiv

/- It is obvious from the definition that `~` is an equivalence relation.

Program equivalence can be used to replace subprograms by other subprograms with
the same semantics. This is achieved by the following congruence rules: -/

lemma denote_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt}
    (hS : S₁ ~ S₂) (hT : T₁ ~ T₂) :
  S₁ ;; T₁ ~ S₂ ;; T₂ :=
by simp [denote_equiv, denote, *] at *

lemma denote_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt}
    (hS : S₁ ~ S₂) (hT : T₁ ~ T₂) :
  stmt.ite b S₁ T₁ ~ stmt.ite b S₂ T₂ :=
by simp [denote_equiv, denote, *] at *

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt}
    (hS : S₁ ~ S₂) :
  stmt.while b S₁ ~ stmt.while b S₂ :=
by simp [denote_equiv, denote, *] at *

/- Compare the simplicity of these proofs with the corresponding proofs for a
big-step semantics (exercise 8).

Let us prove some program equivalences. -/

lemma denote_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ~ stmt.skip :=
by simp [denote_equiv, denote, Id]

lemma denote_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ~ S :=
by simp [denote_equiv, denote, Id, comp]

lemma denote_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ~ S :=
by simp [denote_equiv, denote, Id, comp]

lemma denote_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ~ stmt.while b S :=
begin
  simp [denote_equiv, denote],
  apply eq.symm,
  apply lfp_eq,
  apply monotone_union,
  { apply sorry_lemmas.monotone_restrict,
    apply sorry_lemmas.monotone_comp,
    { exact monotone_const _ },
    { exact monotone_id } },
  { apply sorry_lemmas.monotone_restrict,
    exact monotone_const _ }
end

/- ## Equivalence of the Denotational and the Big-Step Semantics
## (**optional**) -/

lemma denote_of_big_step (S : stmt) (s t : state) (h : (S, s) ⟹ t) :
  (s, t) ∈ ⟦S⟧ :=
begin
  induction' h; try { solve1 { simp [denote, *] } },
  case seq {
    apply exists.intro t,
    exact and.intro ih_h ih_h_1 },
  case while_true {
    rw eq.symm denote_equiv.ite_seq_while,
    simp [denote, *],
    apply exists.intro t,
    apply and.intro; assumption },
  case while_false {
    rw eq.symm denote_equiv.ite_seq_while,
    simp [denote, *] }
end

lemma big_step_of_denote :
  ∀(S : stmt) (s t : state), (s, t) ∈ ⟦S⟧ → (S, s) ⟹ t
| stmt.skip         s t := by simp [denote]
| (stmt.assign n a) s t := by simp [denote]
| (stmt.seq S T)    s t :=
  begin
    intro h,
    cases' h with u hu,
    exact big_step.seq
      (big_step_of_denote S _ _ (and.elim_left hu))
      (big_step_of_denote T _ _ (and.elim_right hu))
  end
| (stmt.ite b S T)  s t :=
  begin
    intro h,
    cases' h,
    case inl {
      cases' h,
      apply big_step.ite_true left,
      exact big_step_of_denote _ _ _ right },
    case inr {
      cases' h,
      apply big_step.ite_false left,
      exact big_step_of_denote _ _ _ right }
  end
| (stmt.while b S)  s t :=
  begin
    have hw : ⟦stmt.while b S⟧
        ≤ {st | (stmt.while b S, prod.fst st) ⟹ prod.snd st} :=
      begin
        apply lfp_le _ _ _,
        intros x hx,
        cases' x with s' t',
        simp at hx,
        cases' hx,
        case inl {
          cases' h with hs hst,
          cases' hst with u hu,
          apply big_step.while_true hs,
          { exact big_step_of_denote S _ _ (and.elim_left hu) },
          { exact and.elim_right hu } },
        case inr {
          cases' h,
          cases' right,
          apply big_step.while_false left }
      end,
    apply hw
  end

lemma denote_iff_big_step (S : stmt) (s t : state) :
  (s, t) ∈ ⟦S⟧ ↔ (S, s) ⟹ t :=
iff.intro (big_step_of_denote S s t) (denote_of_big_step S s t)

end LoVe


import tutorial_world.level07_split --hide
open IncidencePlane --hide
open set --hide

/- Tactic : use

## Summary
The tactic use specializes the goal with a particular case.
For example, if we want to prove the statement "there exists a natural number which is odd",
we will need to provide a concrete number like 3.
-/

/-
Sometimes we will need to prove that there exists an object satisfying certain properties.
The goal will then look like ⊢ ∃ x, P x. In this case, the `use` tactic is useful. If we know
that an object `a` satisfies the  property `P`, then `use a` will transform the goal into ⊢ P a.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma : no-side-bar
Given a point, there is always a line containing it.
-/
lemma line_containing_point (P : Ω) : ∃ ℓ : Line Ω, P ∈ ℓ :=
begin
  use line_through P P,
  exact line_through_left P P,

end