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

! This file was ported from Lean 3 source module analysis.convex.krein_milman
! leanprover-community/mathlib commit 279297937dede7b1b3451b7b0f1786352ad011fa
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Exposed
import Mathbin.Analysis.NormedSpace.HahnBanach.Separation

/-!
# The Krein-Milman theorem

This file proves the Krein-Milman lemma and the Krein-Milman theorem.

## The lemma

The lemma states that a nonempty compact set `s` has an extreme point. The proof goes:
1. Using Zorn's lemma, find a minimal nonempty closed `t` that is an extreme subset of `s`. We will
  show that `t` is a singleton, thus corresponding to an extreme point.
2. By contradiction, `t` contains two distinct points `x` and `y`.
3. With the (geometric) Hahn-Banach theorem, find an hyperplane that separates `x` and `y`.
4. Look at the extreme (actually exposed) subset of `t` obtained by going the furthest away from
  the separating hyperplane in the direction of `x`. It is nonempty, closed and an extreme subset
  of `s`.
5. It is a strict subset of `t` (`y` isn't in it), so `t` isn't minimal. Absurd.

## The theorem

The theorem states that a compact convex set `s` is the closure of the convex hull of its extreme
points. It is an almost immediate strengthening of the lemma. The proof goes:
1. By contradiction, `s \ closure (convex_hull ℝ (extreme_points ℝ s))` is nonempty, say with `x`.
2. With the (geometric) Hahn-Banach theorem, find an hyperplane that separates `x` from
  `closure (convex_hull ℝ (extreme_points ℝ s))`.
3. Look at the extreme (actually exposed) subset of
  `s \ closure (convex_hull ℝ (extreme_points ℝ s))` obtained by going the furthest away from the
  separating hyperplane. It is nonempty by assumption of nonemptiness and compactness, so by the
  lemma it has an extreme point.
4. This point is also an extreme point of `s`. Absurd.

## Related theorems

When the space is finite dimensional, the `closure` can be dropped to strengthen the result of the
Krein-Milman theorem. This leads to the Minkowski-Carathéodory theorem (currently not in mathlib).
Birkhoff's theorem is the Minkowski-Carathéodory theorem applied to the set of bistochastic
matrices, permutation matrices being the extreme points.

## References

See chapter 8 of [Barry Simon, *Convexity*][simon2011]

-/

open Set

open Classical

variable {E : Type _} [AddCommGroup E] [Module ℝ E] [TopologicalSpace E] [T2Space E]
  [TopologicalAddGroup E] [ContinuousSMul ℝ E] [LocallyConvexSpace ℝ E] {s : Set E}

/-- **Krein-Milman lemma**: In a LCTVS, any nonempty compact set has an extreme point. -/
theorem IsCompact.has_extreme_point (hscomp : IsCompact s) (hsnemp : s.Nonempty) :
    (s.extremePoints ℝ).Nonempty :=
  by
  let S : Set (Set E) := { t | t.Nonempty ∧ IsClosed t ∧ IsExtreme ℝ s t }
  rsuffices ⟨t, ⟨⟨x, hxt⟩, htclos, hst⟩, hBmin⟩ : ∃ t ∈ S, ∀ u ∈ S, u ⊆ t → u = t
  · refine' ⟨x, mem_extremePoints_iff_extreme_singleton.2 _⟩
    rwa [← eq_singleton_iff_unique_mem.2 ⟨hxt, fun y hyB => _⟩]
    by_contra hyx
    obtain ⟨l, hl⟩ := geometric_hahn_banach_point_point hyx
    obtain ⟨z, hzt, hz⟩ :=
      (isCompact_of_isClosed_subset hscomp htclos hst.1).exists_forall_ge ⟨x, hxt⟩
        l.continuous.continuous_on
    have h : IsExposed ℝ t ({ z ∈ t | ∀ w ∈ t, l w ≤ l z }) := fun h => ⟨l, rfl⟩
    rw [←
      hBmin ({ z ∈ t | ∀ w ∈ t, l w ≤ l z })
        ⟨⟨z, hzt, hz⟩, h.is_closed htclos, hst.trans h.is_extreme⟩ (t.sep_subset _)] at
      hyB
    exact hl.not_le (hyB.2 x hxt)
  refine' zorn_superset _ fun F hFS hF => _
  obtain rfl | hFnemp := F.eq_empty_or_nonempty
  · exact ⟨s, ⟨hsnemp, hscomp.is_closed, IsExtreme.rfl⟩, fun _ => False.elim⟩
  refine'
    ⟨⋂₀ F,
      ⟨_, isClosed_interₛ fun t ht => (hFS ht).2.1,
        isExtreme_interₛ hFnemp fun t ht => (hFS ht).2.2⟩,
      fun t ht => sInter_subset_of_mem ht⟩
  haveI : Nonempty ↥F := hFnemp.to_subtype
  rw [sInter_eq_Inter]
  refine'
    IsCompact.nonempty_interᵢ_of_directed_nonempty_compact_closed _ (fun t u => _)
      (fun t => (hFS t.Mem).1)
      (fun t => isCompact_of_isClosed_subset hscomp (hFS t.Mem).2.1 (hFS t.Mem).2.2.1) fun t =>
      (hFS t.Mem).2.1
  obtain htu | hut := hF.total t.mem u.mem
  exacts[⟨t, subset.rfl, htu⟩, ⟨u, hut, subset.rfl⟩]
#align is_compact.has_extreme_point IsCompact.has_extreme_point

/-- **Krein-Milman theorem**: In a LCTVS, any compact convex set is the closure of the convex hull
    of its extreme points. -/
theorem closure_convexHull_extremePoints (hscomp : IsCompact s) (hAconv : Convex ℝ s) :
    closure (convexHull ℝ <| s.extremePoints ℝ) = s :=
  by
  apply (closure_minimal (convexHull_min extremePoints_subset hAconv) hscomp.is_closed).antisymm
  by_contra hs
  obtain ⟨x, hxA, hxt⟩ := not_subset.1 hs
  obtain ⟨l, r, hlr, hrx⟩ :=
    geometric_hahn_banach_closed_point (convex_convexHull _ _).closure isClosed_closure hxt
  have h : IsExposed ℝ s ({ y ∈ s | ∀ z ∈ s, l z ≤ l y }) := fun _ => ⟨l, rfl⟩
  obtain ⟨z, hzA, hz⟩ := hscomp.exists_forall_ge ⟨x, hxA⟩ l.continuous.continuous_on
  obtain ⟨y, hy⟩ := (h.is_compact hscomp).has_extreme_point ⟨z, hzA, hz⟩
  linarith [hlr _
      (subset_closure <|
        subset_convexHull _ _ <| h.is_extreme.extreme_points_subset_extreme_points hy),
    hy.1.2 x hxA]
#align closure_convex_hull_extreme_points closure_convexHull_extremePoints


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

! This file was ported from Lean 3 source module analysis.calculus.lagrange_multipliers
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Calculus.Inverse
import Mathbin.LinearAlgebra.Dual

/-!
# Lagrange multipliers

In this file we formalize the
[Lagrange multipliers](https://en.wikipedia.org/wiki/Lagrange_multiplier) method of solving
conditional extremum problems: if a function `φ` has a local extremum at `x₀` on the set
`f ⁻¹' {f x₀}`, `f x = (f₀ x, ..., fₙ₋₁ x)`, then the differentials of `fₖ` and `φ` are linearly
dependent. First we formulate a geometric version of this theorem which does not rely on the
target space being `ℝⁿ`, then restate it in terms of coordinates.

## TODO

Formalize Karush-Kuhn-Tucker theorem

## Tags

lagrange multiplier, local extremum

-/

open Filter Set

open Topology Filter BigOperators

variable {E F : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]
  [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] {f : E → F} {φ : E → ℝ} {x₀ : E}
  {f' : E →L[ℝ] F} {φ' : E →L[ℝ] ℝ}

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, both `f : E → F` and `φ` are strictly differentiable at `x₀`, and the codomain of `f` is
a complete space, then the linear map `x ↦ (f' x, φ' x)` is not surjective. -/
theorem IsLocalExtrOn.range_ne_top_of_hasStrictFderivAt
    (hextr : IsLocalExtrOn φ { x | f x = f x₀ } x₀) (hf' : HasStrictFderivAt f f' x₀)
    (hφ' : HasStrictFderivAt φ φ' x₀) : LinearMap.range (f'.Prod φ') ≠ ⊤ :=
  by
  intro htop
  set fφ := fun x => (f x, φ x)
  have A : map φ (𝓝[f ⁻¹' {f x₀}] x₀) = 𝓝 (φ x₀) :=
    by
    change map (Prod.snd ∘ fφ) (𝓝[fφ ⁻¹' { p | p.1 = f x₀ }] x₀) = 𝓝 (φ x₀)
    rw [← map_map, nhdsWithin, map_inf_principal_preimage, (hf'.prod hφ').map_nhds_eq_of_surj htop]
    exact map_snd_nhdsWithin _
  exact hextr.not_nhds_le_map A.ge
#align is_local_extr_on.range_ne_top_of_has_strict_fderiv_at IsLocalExtrOn.range_ne_top_of_hasStrictFderivAt

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, both `f : E → F` and `φ` are strictly differentiable at `x₀`, and the codomain of `f` is
a complete space, then there exist `Λ : dual ℝ F` and `Λ₀ : ℝ` such that `(Λ, Λ₀) ≠ 0` and
`Λ (f' x) + Λ₀ • φ' x = 0` for all `x`. -/
theorem IsLocalExtrOn.exists_linear_map_of_hasStrictFderivAt
    (hextr : IsLocalExtrOn φ { x | f x = f x₀ } x₀) (hf' : HasStrictFderivAt f f' x₀)
    (hφ' : HasStrictFderivAt φ φ' x₀) :
    ∃ (Λ : Module.Dual ℝ F)(Λ₀ : ℝ), (Λ, Λ₀) ≠ 0 ∧ ∀ x, Λ (f' x) + Λ₀ • φ' x = 0 :=
  by
  rcases Submodule.exists_le_ker_of_lt_top _
      (lt_top_iff_ne_top.2 <| hextr.range_ne_top_of_has_strict_fderiv_at hf' hφ') with
    ⟨Λ', h0, hΛ'⟩
  set e : ((F →ₗ[ℝ] ℝ) × ℝ) ≃ₗ[ℝ] F × ℝ →ₗ[ℝ] ℝ :=
    ((LinearEquiv.refl ℝ (F →ₗ[ℝ] ℝ)).Prod (LinearMap.ringLmapEquivSelf ℝ ℝ ℝ).symm).trans
      (LinearMap.coprodEquiv ℝ)
  rcases e.surjective Λ' with ⟨⟨Λ, Λ₀⟩, rfl⟩
  refine' ⟨Λ, Λ₀, e.map_ne_zero_iff.1 h0, fun x => _⟩
  convert LinearMap.congr_fun (LinearMap.range_le_ker_iff.1 hΛ') x using 1
  -- squeezed `simp [mul_comm]` to speed up elaboration
  simp only [mul_comm, Algebra.id.smul_eq_mul, LinearEquiv.trans_apply, LinearEquiv.prod_apply,
    LinearEquiv.refl_apply, LinearMap.ringLmapEquivSelf_symm_apply, LinearMap.coprodEquiv_apply,
    ContinuousLinearMap.toLinearMap_eq_coe, ContinuousLinearMap.coe_prod,
    LinearMap.coprod_comp_prod, LinearMap.add_apply, LinearMap.coe_comp,
    ContinuousLinearMap.coe_coe, LinearMap.coe_smulRight, LinearMap.one_apply]
#align is_local_extr_on.exists_linear_map_of_has_strict_fderiv_at IsLocalExtrOn.exists_linear_map_of_hasStrictFderivAt

/-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}`
at `x₀`, and both `f : E → ℝ` and `φ` are strictly differentiable at `x₀`, then there exist
`a b : ℝ` such that `(a, b) ≠ 0` and `a • f' + b • φ' = 0`. -/
theorem IsLocalExtrOn.exists_multipliers_of_hasStrictFderivAt_1d {f : E → ℝ} {f' : E →L[ℝ] ℝ}
    (hextr : IsLocalExtrOn φ { x | f x = f x₀ } x₀) (hf' : HasStrictFderivAt f f' x₀)
    (hφ' : HasStrictFderivAt φ φ' x₀) : ∃ a b : ℝ, (a, b) ≠ 0 ∧ a • f' + b • φ' = 0 :=
  by
  obtain ⟨Λ, Λ₀, hΛ, hfΛ⟩ := hextr.exists_linear_map_of_has_strict_fderiv_at hf' hφ'
  refine' ⟨Λ 1, Λ₀, _, _⟩
  · contrapose! hΛ
    simp only [Prod.mk_eq_zero] at hΛ⊢
    refine' ⟨LinearMap.ext fun x => _, hΛ.2⟩
    simpa [hΛ.1] using Λ.map_smul x 1
  · ext x
    have H₁ : Λ (f' x) = f' x * Λ 1 := by
      simpa only [mul_one, Algebra.id.smul_eq_mul] using Λ.map_smul (f' x) 1
    have H₂ : f' x * Λ 1 + Λ₀ * φ' x = 0 := by simpa only [Algebra.id.smul_eq_mul, H₁] using hfΛ x
    simpa [mul_comm] using H₂
#align is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at_1d IsLocalExtrOn.exists_multipliers_of_hasStrictFderivAt_1d

/-- Lagrange multipliers theorem, 1d version. Let `f : ι → E → ℝ` be a finite family of functions.
Suppose that `φ : E → ℝ` has a local extremum on the set `{x | ∀ i, f i x = f i x₀}` at `x₀`.
Suppose that all functions `f i` as well as `φ` are strictly differentiable at `x₀`.
Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are linearly dependent:
there exist `Λ : ι → ℝ` and `Λ₀ : ℝ`, `(Λ, Λ₀) ≠ 0`, such that `∑ i, Λ i • f' i + Λ₀ • φ' = 0`.

See also `is_local_extr_on.linear_dependent_of_has_strict_fderiv_at` for a version that
states `¬linear_independent ℝ _` instead of existence of `Λ` and `Λ₀`. -/
theorem IsLocalExtrOn.exists_multipliers_of_hasStrictFderivAt {ι : Type _} [Fintype ι]
    {f : ι → E → ℝ} {f' : ι → E →L[ℝ] ℝ} (hextr : IsLocalExtrOn φ { x | ∀ i, f i x = f i x₀ } x₀)
    (hf' : ∀ i, HasStrictFderivAt (f i) (f' i) x₀) (hφ' : HasStrictFderivAt φ φ' x₀) :
    ∃ (Λ : ι → ℝ)(Λ₀ : ℝ), (Λ, Λ₀) ≠ 0 ∧ (∑ i, Λ i • f' i) + Λ₀ • φ' = 0 :=
  by
  letI := Classical.decEq ι
  replace hextr : IsLocalExtrOn φ { x | (fun i => f i x) = fun i => f i x₀ } x₀
  · simpa only [Function.funext_iff] using hextr
  rcases hextr.exists_linear_map_of_has_strict_fderiv_at (hasStrictFderivAt_pi.2 fun i => hf' i)
      hφ' with
    ⟨Λ, Λ₀, h0, hsum⟩
  rcases(LinearEquiv.piRing ℝ ℝ ι ℝ).symm.Surjective Λ with ⟨Λ, rfl⟩
  refine' ⟨Λ, Λ₀, _, _⟩
  · simpa only [Ne.def, Prod.ext_iff, LinearEquiv.map_eq_zero_iff, Prod.fst_zero] using h0
  · ext x
    simpa [mul_comm] using hsum x
#align is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at IsLocalExtrOn.exists_multipliers_of_hasStrictFderivAt

/-- Lagrange multipliers theorem. Let `f : ι → E → ℝ` be a finite family of functions.
Suppose that `φ : E → ℝ` has a local extremum on the set `{x | ∀ i, f i x = f i x₀}` at `x₀`.
Suppose that all functions `f i` as well as `φ` are strictly differentiable at `x₀`.
Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are linearly dependent.

See also `is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at` for a version that
that states existence of Lagrange multipliers `Λ` and `Λ₀` instead of using
`¬linear_independent ℝ _` -/
theorem IsLocalExtrOn.linear_dependent_of_hasStrictFderivAt {ι : Type _} [Finite ι] {f : ι → E → ℝ}
    {f' : ι → E →L[ℝ] ℝ} (hextr : IsLocalExtrOn φ { x | ∀ i, f i x = f i x₀ } x₀)
    (hf' : ∀ i, HasStrictFderivAt (f i) (f' i) x₀) (hφ' : HasStrictFderivAt φ φ' x₀) :
    ¬LinearIndependent ℝ (Option.elim' φ' f' : Option ι → E →L[ℝ] ℝ) :=
  by
  cases nonempty_fintype ι
  rw [Fintype.linearIndependent_iff]; push_neg
  rcases hextr.exists_multipliers_of_has_strict_fderiv_at hf' hφ' with ⟨Λ, Λ₀, hΛ, hΛf⟩
  refine' ⟨Option.elim' Λ₀ Λ, _, _⟩
  · simpa [add_comm] using hΛf
  · simpa [Function.funext_iff, not_and_or, or_comm', Option.exists] using hΛ
#align is_local_extr_on.linear_dependent_of_has_strict_fderiv_at IsLocalExtrOn.linear_dependent_of_hasStrictFderivAt


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández

! This file was ported from Lean 3 source module ring_theory.dedekind_domain.factorization
! leanprover-community/mathlib commit 2f588be38bb5bec02f218ba14f82fc82eb663f87
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.DedekindDomain.Ideal

/-!
# Factorization of ideals of Dedekind domains
Every nonzero ideal `I` of a Dedekind domain `R` can be factored as a product `∏_v v^{n_v}` over the
maximal ideals of `R`, where the exponents `n_v` are natural numbers.
TODO: Extend the results in this file to fractional ideals of `R`.
## Main results
- `ideal.finite_factors` : Only finitely many maximal ideals of `R` divide a given nonzero ideal.
- `ideal.finprod_height_one_spectrum_factorization` : The ideal `I` equals the finprod
  `∏_v v^(val_v(I))`,where `val_v(I)` denotes the multiplicity of `v` in the factorization of `I`
  and `v` runs over the maximal ideals of `R`.
## Tags
dedekind domain, ideal, factorization
-/

noncomputable section

open BigOperators Classical nonZeroDivisors

open Set Function UniqueFactorizationMonoid IsDedekindDomain IsDedekindDomain.HeightOneSpectrum

/-! ### Factorization of ideals of Dedekind domains -/

variable {R : Type _} [CommRing R] [IsDomain R] [IsDedekindDomain R] {K : Type _} [Field K]
  [Algebra R K] [IsFractionRing R K] (v : HeightOneSpectrum R)

/-- Given a maximal ideal `v` and an ideal `I` of `R`, `max_pow_dividing` returns the maximal
  power of `v` dividing `I`. -/
def IsDedekindDomain.HeightOneSpectrum.maxPowDividing (I : Ideal R) : Ideal R :=
  v.asIdeal ^ (Associates.mk v.asIdeal).count (Associates.mk I).factors
#align is_dedekind_domain.height_one_spectrum.max_pow_dividing IsDedekindDomain.HeightOneSpectrum.maxPowDividing

/-- Only finitely many maximal ideals of `R` divide a given nonzero ideal. -/
theorem Ideal.finite_factors {I : Ideal R} (hI : I ≠ 0) :
    { v : HeightOneSpectrum R | v.asIdeal ∣ I }.Finite :=
  by
  rw [← Set.finite_coe_iff, Set.coe_setOf]
  haveI h_fin := fintype_subtype_dvd I hI
  refine'
    Finite.of_injective (fun v => (⟨(v : height_one_spectrum R).asIdeal, v.2⟩ : { x // x ∣ I })) _
  intro v w hvw
  simp only at hvw
  exact Subtype.coe_injective ((height_one_spectrum.ext_iff ↑v ↑w).mpr hvw)
#align ideal.finite_factors Ideal.finite_factors

/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that the
  multiplicity of `v` in the factorization of `I`, denoted `val_v(I)`, is nonzero. -/
theorem Associates.finite_factors {I : Ideal R} (hI : I ≠ 0) :
    ∀ᶠ v : HeightOneSpectrum R in Filter.cofinite,
      ((Associates.mk v.asIdeal).count (Associates.mk I).factors : ℤ) = 0 :=
  by
  have h_supp :
    { v : height_one_spectrum R |
        ¬((Associates.mk v.asIdeal).count (Associates.mk I).factors : ℤ) = 0 } =
      { v : height_one_spectrum R | v.asIdeal ∣ I } :=
    by
    ext v
    simp_rw [Int.coe_nat_eq_zero]
    exact Associates.count_ne_zero_iff_dvd hI v.irreducible
  rw [Filter.eventually_cofinite, h_supp]
  exact Ideal.finite_factors hI
#align associates.finite_factors Associates.finite_factors

namespace Ideal

/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that
  `v^(val_v(I))` is not the unit ideal. -/
theorem finite_mulSupport {I : Ideal R} (hI : I ≠ 0) :
    (mulSupport fun v : HeightOneSpectrum R => v.maxPowDividing I).Finite :=
  haveI h_subset :
    { v : height_one_spectrum R | v.maxPowDividing I ≠ 1 } ⊆
      { v : height_one_spectrum R |
        ((Associates.mk v.asIdeal).count (Associates.mk I).factors : ℤ) ≠ 0 } :=
    by
    intro v hv h_zero
    have hv' : v.max_pow_dividing I = 1 := by
      rw [IsDedekindDomain.HeightOneSpectrum.maxPowDividing, int.coe_nat_eq_zero.mp h_zero,
        pow_zero _]
    exact hv hv'
  finite.subset (filter.eventually_cofinite.mp (Associates.finite_factors hI)) h_subset
#align ideal.finite_mul_support Ideal.finite_mulSupport

/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that
`v^(val_v(I))`, regarded as a fractional ideal, is not `(1)`. -/
theorem finite_mulSupport_coe {I : Ideal R} (hI : I ≠ 0) :
    (mulSupport fun v : HeightOneSpectrum R =>
        (v.asIdeal : FractionalIdeal R⁰ K) ^
          ((Associates.mk v.asIdeal).count (Associates.mk I).factors : ℤ)).Finite :=
  by
  rw [mul_support]
  simp_rw [Ne.def, zpow_ofNat, ← FractionalIdeal.coe_ideal_pow, FractionalIdeal.coe_ideal_eq_one]
  exact finite_mul_support hI
#align ideal.finite_mul_support_coe Ideal.finite_mulSupport_coe

/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that
`v^-(val_v(I))` is not the unit ideal. -/
theorem finite_mulSupport_inv {I : Ideal R} (hI : I ≠ 0) :
    (mulSupport fun v : HeightOneSpectrum R =>
        (v.asIdeal : FractionalIdeal R⁰ K) ^
          (-((Associates.mk v.asIdeal).count (Associates.mk I).factors : ℤ))).Finite :=
  by
  rw [mul_support]
  simp_rw [zpow_neg, Ne.def, inv_eq_one]
  exact finite_mul_support_coe hI
#align ideal.finite_mul_support_inv Ideal.finite_mulSupport_inv

/-- For every nonzero ideal `I` of `v`, `v^(val_v(I) + 1)` does not divide `∏_v v^(val_v(I))`. -/
theorem finprod_not_dvd (I : Ideal R) (hI : I ≠ 0) :
    ¬v.asIdeal ^ ((Associates.mk v.asIdeal).count (Associates.mk I).factors + 1) ∣
        ∏ᶠ v : HeightOneSpectrum R, v.maxPowDividing I :=
  by
  have hf := finite_mul_support hI
  have h_ne_zero : v.max_pow_dividing I ≠ 0 := pow_ne_zero _ v.ne_bot
  rw [← mul_finprod_cond_ne v hf, pow_add, pow_one, finprod_cond_ne _ _ hf]
  intro h_contr
  have hv_prime : Prime v.as_ideal := Ideal.prime_of_isPrime v.ne_bot v.is_prime
  obtain ⟨w, hw, hvw'⟩ :=
    Prime.exists_mem_finset_dvd hv_prime ((mul_dvd_mul_iff_left h_ne_zero).mp h_contr)
  have hw_prime : Prime w.as_ideal := Ideal.prime_of_isPrime w.ne_bot w.is_prime
  have hvw := Prime.dvd_of_dvd_pow hv_prime hvw'
  rw [Prime.dvd_prime_iff_associated hv_prime hw_prime, associated_iff_eq] at hvw
  exact (finset.mem_erase.mp hw).1 (height_one_spectrum.ext w v (Eq.symm hvw))
#align ideal.finprod_not_dvd Ideal.finprod_not_dvd

end Ideal

theorem Associates.finprod_ne_zero (I : Ideal R) :
    Associates.mk (∏ᶠ v : HeightOneSpectrum R, v.maxPowDividing I) ≠ 0 :=
  by
  rw [Associates.mk_ne_zero, finprod_def]
  split_ifs
  · rw [Finset.prod_ne_zero_iff]
    intro v hv
    apply pow_ne_zero _ v.ne_bot
  · exact one_ne_zero
#align associates.finprod_ne_zero Associates.finprod_ne_zero

namespace Ideal

/-- The multiplicity of `v` in `∏_v v^(val_v(I))` equals `val_v(I)`. -/
theorem finprod_count (I : Ideal R) (hI : I ≠ 0) :
    (Associates.mk v.asIdeal).count
        (Associates.mk (∏ᶠ v : HeightOneSpectrum R, v.maxPowDividing I)).factors =
      (Associates.mk v.asIdeal).count (Associates.mk I).factors :=
  by
  have h_ne_zero := Associates.finprod_ne_zero I
  have hv : Irreducible (Associates.mk v.as_ideal) := v.associates_irreducible
  have h_dvd := finprod_mem_dvd v (Ideal.finite_mulSupport hI)
  have h_not_dvd := Ideal.finprod_not_dvd v I hI
  simp only [IsDedekindDomain.HeightOneSpectrum.maxPowDividing] at h_dvd h_ne_zero h_not_dvd
  rw [← Associates.mk_dvd_mk, Associates.dvd_eq_le, Associates.mk_pow,
    Associates.prime_pow_dvd_iff_le h_ne_zero hv] at h_dvd h_not_dvd
  rw [not_le] at h_not_dvd
  apply Nat.eq_of_le_of_lt_succ h_dvd h_not_dvd
#align ideal.finprod_count Ideal.finprod_count

/-- The ideal `I` equals the finprod `∏_v v^(val_v(I))`. -/
theorem finprod_heightOneSpectrum_factorization (I : Ideal R) (hI : I ≠ 0) :
    (∏ᶠ v : HeightOneSpectrum R, v.maxPowDividing I) = I :=
  by
  rw [← associated_iff_eq, ← Associates.mk_eq_mk_iff_associated]
  apply Associates.eq_of_eq_counts
  · apply Associates.finprod_ne_zero I
  · apply associates.mk_ne_zero.mpr hI
  intro v hv
  obtain ⟨J, hJv⟩ := Associates.exists_rep v
  rw [← hJv, Associates.irreducible_mk] at hv
  rw [← hJv]
  apply
    Ideal.finprod_count
      ⟨J, Ideal.isPrime_of_prime (irreducible_iff_prime.mp hv), Irreducible.ne_zero hv⟩ I hI
#align ideal.finprod_height_one_spectrum_factorization Ideal.finprod_heightOneSpectrum_factorization

/-- The ideal `I` equals the finprod `∏_v v^(val_v(I))`, when both sides are regarded as fractional
ideals of `R`. -/
theorem finprod_heightOneSpectrum_factorization_coe (I : Ideal R) (hI : I ≠ 0) :
    (∏ᶠ v : HeightOneSpectrum R,
        (v.asIdeal : FractionalIdeal R⁰ K) ^
          ((Associates.mk v.asIdeal).count (Associates.mk I).factors : ℤ)) =
      I :=
  by
  conv_rhs => rw [← Ideal.finprod_heightOneSpectrum_factorization I hI]
  rw [FractionalIdeal.coe_ideal_finprod R⁰ K (le_refl _)]
  simp_rw [IsDedekindDomain.HeightOneSpectrum.maxPowDividing, FractionalIdeal.coe_ideal_pow,
    zpow_ofNat]
#align ideal.finprod_height_one_spectrum_factorization_coe Ideal.finprod_heightOneSpectrum_factorization_coe

end Ideal


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Alena Gusakov
-/
import data.fintype.basic
import data.sym2
import data.set.finite
/-!
# Simple graphs

This module defines simple graphs on a vertex type `V` as an
irreflexive symmetric relation.

There is a basic API for locally finite graphs and for graphs with
finitely many vertices.

## Main definitions

* `simple_graph` is a structure for symmetric, irreflexive relations

* `neighbor_set` is the `set` of vertices adjacent to a given vertex

* `common_neighbors` is the intersection of the neighbor sets of two given vertices

* `neighbor_finset` is the `finset` of vertices adjacent to a given vertex,
   if `neighbor_set` is finite

* `incidence_set` is the `set` of edges containing a given vertex

* `incidence_finset` is the `finset` of edges containing a given vertex,
   if `incidence_set` is finite

## Implementation notes

* A locally finite graph is one with instances `∀ v, fintype (G.neighbor_set v)`.

* Given instances `decidable_rel G.adj` and `fintype V`, then the graph
  is locally finite, too.

## Naming Conventions

* If the vertex type of a graph is finite, we refer to its cardinality as `card_verts`.

TODO: This is the simplest notion of an unoriented graph.  This should
eventually fit into a more complete combinatorics hierarchy which
includes multigraphs and directed graphs.  We begin with simple graphs
in order to start learning what the combinatorics hierarchy should
look like.

TODO: Part of this would include defining, for example, subgraphs of a
simple graph.

-/
open finset
universe u

/--
A simple graph is an irreflexive symmetric relation `adj` on a vertex type `V`.
The relation describes which pairs of vertices are adjacent.
There is exactly one edge for every pair of adjacent edges;
see `simple_graph.edge_set` for the corresponding edge set.
-/
@[ext]
structure simple_graph (V : Type u) :=
(adj : V → V → Prop)
(sym : symmetric adj . obviously)
(loopless : irreflexive adj . obviously)

/--
Construct the simple graph induced by the given relation.  It
symmetrizes the relation and makes it irreflexive.
-/
def simple_graph.from_rel {V : Type u} (r : V → V → Prop) : simple_graph V :=
{ adj := λ a b, (a ≠ b) ∧ (r a b ∨ r b a),
  sym := λ a b ⟨hn, hr⟩, ⟨hn.symm, hr.symm⟩,
  loopless := λ a ⟨hn, _⟩, hn rfl }

noncomputable instance {V : Type u} [fintype V] : fintype (simple_graph V) :=
by { classical, exact fintype.of_injective simple_graph.adj simple_graph.ext }

@[simp]
lemma simple_graph.from_rel_adj {V : Type u} (r : V → V → Prop) (v w : V) :
  (simple_graph.from_rel r).adj v w ↔ v ≠ w ∧ (r v w ∨ r w v) :=
iff.rfl

/--
The complete graph on a type `V` is the simple graph with all pairs of distinct vertices adjacent.
-/
def complete_graph (V : Type u) : simple_graph V :=
{ adj := ne }

instance (V : Type u) : inhabited (simple_graph V) :=
⟨complete_graph V⟩

instance complete_graph_adj_decidable (V : Type u) [decidable_eq V] :
  decidable_rel (complete_graph V).adj :=
λ v w, not.decidable

namespace simple_graph
variables {V : Type u} (G : simple_graph V)

/-- `G.neighbor_set v` is the set of vertices adjacent to `v` in `G`. -/
def neighbor_set (v : V) : set V := set_of (G.adj v)

instance neighbor_set.mem_decidable (v : V) [decidable_rel G.adj] :
  decidable_pred (G.neighbor_set v) := by { unfold neighbor_set, apply_instance }

lemma ne_of_adj {a b : V} (hab : G.adj a b) : a ≠ b :=
by { rintro rfl, exact G.loopless a hab }

/--
The edges of G consist of the unordered pairs of vertices related by
`G.adj`.
-/
def edge_set : set (sym2 V) := sym2.from_rel G.sym

/--
The `incidence_set` is the set of edges incident to a given vertex.
-/
def incidence_set (v : V) : set (sym2 V) := {e ∈ G.edge_set | v ∈ e}

lemma incidence_set_subset (v : V) : G.incidence_set v ⊆ G.edge_set :=
λ _ h, h.1

@[simp]
lemma mem_edge_set {v w : V} : ⟦(v, w)⟧ ∈ G.edge_set ↔ G.adj v w :=
by refl

/--
Two vertices are adjacent iff there is an edge between them.  The
condition `v ≠ w` ensures they are different endpoints of the edge,
which is necessary since when `v = w` the existential
`∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e` is satisfied by every edge
incident to `v`.
-/
lemma adj_iff_exists_edge {v w : V} :
  G.adj v w ↔ v ≠ w ∧ ∃ (e ∈ G.edge_set), v ∈ e ∧ w ∈ e :=
begin
  refine ⟨λ _, ⟨G.ne_of_adj ‹_›, ⟦(v,w)⟧, _⟩, _⟩,
  { simpa },
  { rintro ⟨hne, e, he, hv⟩,
    rw sym2.elems_iff_eq hne at hv,
    subst e,
    rwa mem_edge_set at he }
end

lemma edge_other_ne {e : sym2 V} (he : e ∈ G.edge_set) {v : V} (h : v ∈ e) : h.other ≠ v :=
begin
  erw [← sym2.mem_other_spec h, sym2.eq_swap] at he,
  exact G.ne_of_adj he,
end

instance edge_set_decidable_pred [decidable_rel G.adj] :
  decidable_pred G.edge_set := sym2.from_rel.decidable_pred _

instance edges_fintype [decidable_eq V] [fintype V] [decidable_rel G.adj] :
  fintype G.edge_set := subtype.fintype _

instance incidence_set_decidable_pred [decidable_eq V] [decidable_rel G.adj] (v : V) :
  decidable_pred (G.incidence_set v) := λ e, and.decidable

/--
The `edge_set` of the graph as a `finset`.
-/
def edge_finset [decidable_eq V] [fintype V] [decidable_rel G.adj] : finset (sym2 V) :=
set.to_finset G.edge_set

@[simp] lemma mem_edge_finset [decidable_eq V] [fintype V] [decidable_rel G.adj] (e : sym2 V) :
  e ∈ G.edge_finset ↔ e ∈ G.edge_set :=
set.mem_to_finset

@[simp] lemma edge_set_univ_card [decidable_eq V] [fintype V] [decidable_rel G.adj] :
  (univ : finset G.edge_set).card = G.edge_finset.card :=
fintype.card_of_subtype G.edge_finset (mem_edge_finset _)

@[simp] lemma irrefl {v : V} : ¬G.adj v v := G.loopless v

lemma edge_symm (u v : V) : G.adj u v ↔ G.adj v u := ⟨λ x, G.sym x, λ x, G.sym x⟩

@[symm] lemma edge_symm' {u v : V} (h : G.adj u v) : G.adj v u := G.sym h

@[simp] lemma mem_neighbor_set (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w :=
iff.rfl

@[simp] lemma mem_incidence_set (v w : V) : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ G.adj v w :=
by simp [incidence_set]

lemma mem_incidence_iff_neighbor {v w : V} : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ w ∈ G.neighbor_set v :=
by simp only [mem_incidence_set, mem_neighbor_set]

lemma adj_incidence_set_inter {v : V} {e : sym2 V} (he : e ∈ G.edge_set) (h : v ∈ e) :
  G.incidence_set v ∩ G.incidence_set h.other = {e} :=
begin
  ext e',
  simp only [incidence_set, set.mem_sep_eq, set.mem_inter_eq, set.mem_singleton_iff],
  split,
  { intro h', rw ←sym2.mem_other_spec h,
    exact (sym2.elems_iff_eq (edge_other_ne G he h).symm).mp ⟨h'.1.2, h'.2.2⟩, },
  { rintro rfl, use [he, h, he], apply sym2.mem_other_mem, },
end

/--
The set of common neighbors between two vertices `v` and `w` in a graph `G` is the
intersection of the neighbor sets of `v` and `w`.
-/
def common_neighbors (v w : V) : set V := G.neighbor_set v ∩ G.neighbor_set w

lemma common_neighbors_eq (v w : V) :
  G.common_neighbors v w = G.neighbor_set v ∩ G.neighbor_set w := rfl

lemma mem_common_neighbors {u v w : V} : u ∈ G.common_neighbors v w ↔ G.adj v u ∧ G.adj w u :=
by simp [common_neighbors]

lemma common_neighbors_symm (v w : V) : G.common_neighbors v w = G.common_neighbors w v :=
by { rw [common_neighbors, set.inter_comm], refl }

lemma not_mem_common_neighbors_left (v w : V) : v ∉ G.common_neighbors v w :=
λ h, ne_of_adj G h.1 rfl

lemma not_mem_common_neighbors_right (v w : V) : w ∉ G.common_neighbors v w :=
λ h, ne_of_adj G h.2 rfl

lemma common_neighbors_subset_neighbor_set (v w : V) : G.common_neighbors v w ⊆ G.neighbor_set v :=
by simp [common_neighbors]

instance [decidable_rel G.adj] (v w : V) : decidable_pred (G.common_neighbors v w) :=
λ a, and.decidable

section incidence
variable [decidable_eq V]

/--
Given an edge incident to a particular vertex, get the other vertex on the edge.
-/
def other_vertex_of_incident {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) : V := h.2.other'

lemma edge_mem_other_incident_set {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) :
  e ∈ G.incidence_set (G.other_vertex_of_incident h) :=
by { use h.1, simp [other_vertex_of_incident, sym2.mem_other_mem'] }

lemma incidence_other_prop {v : V} {e : sym2 V} (h : e ∈ G.incidence_set v) :
  G.other_vertex_of_incident h ∈ G.neighbor_set v :=
by { cases h with he hv, rwa [←sym2.mem_other_spec' hv, mem_edge_set] at he }

@[simp]
lemma incidence_other_neighbor_edge {v w : V} (h : w ∈ G.neighbor_set v) :
  G.other_vertex_of_incident (G.mem_incidence_iff_neighbor.mpr h) = w :=
sym2.congr_right.mp (sym2.mem_other_spec' (G.mem_incidence_iff_neighbor.mpr h).right)

/--
There is an equivalence between the set of edges incident to a given
vertex and the set of vertices adjacent to the vertex.
-/
@[simps] def incidence_set_equiv_neighbor_set (v : V) : G.incidence_set v ≃ G.neighbor_set v :=
{ to_fun := λ e, ⟨G.other_vertex_of_incident e.2, G.incidence_other_prop e.2⟩,
  inv_fun := λ w, ⟨⟦(v, w.1)⟧, G.mem_incidence_iff_neighbor.mpr w.2⟩,
  left_inv := λ x, by simp [other_vertex_of_incident],
  right_inv := λ ⟨w, hw⟩, by simp }

end incidence

section finite_at

/-!
## Finiteness at a vertex

This section contains definitions and lemmas concerning vertices that
have finitely many adjacent vertices.  We denote this condition by
`fintype (G.neighbor_set v)`.

We define `G.neighbor_finset v` to be the `finset` version of `G.neighbor_set v`.
Use `neighbor_finset_eq_filter` to rewrite this definition as a `filter`.
-/

variables (v : V) [fintype (G.neighbor_set v)]
/--
`G.neighbors v` is the `finset` version of `G.adj v` in case `G` is
locally finite at `v`.
-/
def neighbor_finset : finset V := (G.neighbor_set v).to_finset

@[simp] lemma mem_neighbor_finset (w : V) :
  w ∈ G.neighbor_finset v ↔ G.adj v w :=
set.mem_to_finset

/--
`G.degree v` is the number of vertices adjacent to `v`.
-/
def degree : ℕ := (G.neighbor_finset v).card

@[simp]
lemma card_neighbor_set_eq_degree : fintype.card (G.neighbor_set v) = G.degree v :=
(set.to_finset_card _).symm

lemma degree_pos_iff_exists_adj : 0 < G.degree v ↔ ∃ w, G.adj v w :=
by simp only [degree, card_pos, finset.nonempty, mem_neighbor_finset]

instance incidence_set_fintype [decidable_eq V] : fintype (G.incidence_set v) :=
fintype.of_equiv (G.neighbor_set v) (G.incidence_set_equiv_neighbor_set v).symm

/--
This is the `finset` version of `incidence_set`.
-/
def incidence_finset [decidable_eq V] : finset (sym2 V) := (G.incidence_set v).to_finset

@[simp]
lemma card_incidence_set_eq_degree [decidable_eq V] :
  fintype.card (G.incidence_set v) = G.degree v :=
by { rw fintype.card_congr (G.incidence_set_equiv_neighbor_set v), simp }

@[simp]
lemma mem_incidence_finset [decidable_eq V] (e : sym2 V) :
  e ∈ G.incidence_finset v ↔ e ∈ G.incidence_set v :=
set.mem_to_finset

end finite_at

section locally_finite

/--
A graph is locally finite if every vertex has a finite neighbor set.
-/
@[reducible]
def locally_finite := Π (v : V), fintype (G.neighbor_set v)

variable [locally_finite G]

/--
A locally finite simple graph is regular of degree `d` if every vertex has degree `d`.
-/
def is_regular_of_degree (d : ℕ) : Prop := ∀ (v : V), G.degree v = d

lemma is_regular_of_degree_eq {d : ℕ} (h : G.is_regular_of_degree d) (v : V) : G.degree v = d := h v

end locally_finite

section finite

variables [fintype V]

instance neighbor_set_fintype [decidable_rel G.adj] (v : V) : fintype (G.neighbor_set v) :=
@subtype.fintype _ _ (by { simp_rw mem_neighbor_set, apply_instance }) _

lemma neighbor_finset_eq_filter {v : V} [decidable_rel G.adj] :
  G.neighbor_finset v = finset.univ.filter (G.adj v) :=
by { ext, simp }

@[simp]
lemma complete_graph_degree [decidable_eq V] (v : V) :
  (complete_graph V).degree v = fintype.card V - 1 :=
begin
  convert univ.card.pred_eq_sub_one,
  erw [degree, neighbor_finset_eq_filter, filter_ne, card_erase_of_mem (mem_univ v)],
end

lemma complete_graph_is_regular [decidable_eq V] :
  (complete_graph V).is_regular_of_degree (fintype.card V - 1) :=
by { intro v, simp }

/--
The minimum degree of all vertices (and `0` if there are no vertices).
The key properties of this are given in `exists_minimal_degree_vertex`, `min_degree_le_degree`
and `le_min_degree_of_forall_le_degree`.
-/
def min_degree [decidable_rel G.adj] : ℕ :=
option.get_or_else (univ.image (λ v, G.degree v)).min 0

/--
There exists a vertex of minimal degree. Note the assumption of being nonempty is necessary, as
the lemma implies there exists a vertex.
-/
lemma exists_minimal_degree_vertex [decidable_rel G.adj] [nonempty V] :
  ∃ v, G.min_degree = G.degree v :=
begin
  obtain ⟨t, ht : _ = _⟩ := min_of_nonempty (univ_nonempty.image (λ v, G.degree v)),
  obtain ⟨v, _, rfl⟩ := mem_image.mp (mem_of_min ht),
  refine ⟨v, by simp [min_degree, ht]⟩,
end

/-- The minimum degree in the graph is at most the degree of any particular vertex. -/
lemma min_degree_le_degree [decidable_rel G.adj] (v : V) : G.min_degree ≤ G.degree v :=
begin
  obtain ⟨t, ht⟩ := finset.min_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)),
  have := finset.min_le_of_mem (mem_image_of_mem _ (mem_univ v)) ht,
  rw option.mem_def at ht,
  rwa [min_degree, ht, option.get_or_else_some],
end

/--
In a nonempty graph, if `k` is at most the degree of every vertex, it is at most the minimum
degree. Note the assumption that the graph is nonempty is necessary as long as `G.min_degree` is
defined to be a natural.
-/
lemma le_min_degree_of_forall_le_degree [decidable_rel G.adj] [nonempty V] (k : ℕ)
  (h : ∀ v, k ≤ G.degree v) :
  k ≤ G.min_degree :=
begin
  rcases G.exists_minimal_degree_vertex with ⟨v, hv⟩,
  rw hv,
  apply h
end

/--
The maximum degree of all vertices (and `0` if there are no vertices).
The key properties of this are given in `exists_maximal_degree_vertex`, `degree_le_max_degree`
and `max_degree_le_of_forall_degree_le`.
-/
def max_degree [decidable_rel G.adj] : ℕ :=
option.get_or_else (univ.image (λ v, G.degree v)).max 0

/--
There exists a vertex of maximal degree. Note the assumption of being nonempty is necessary, as
the lemma implies there exists a vertex.
-/
lemma exists_maximal_degree_vertex [decidable_rel G.adj] [nonempty V] :
  ∃ v, G.max_degree = G.degree v :=
begin
  obtain ⟨t, ht⟩ := max_of_nonempty (univ_nonempty.image (λ v, G.degree v)),
  have ht₂ := mem_of_max ht,
  simp only [mem_image, mem_univ, exists_prop_of_true] at ht₂,
  rcases ht₂ with ⟨v, rfl⟩,
  rw option.mem_def at ht,
  refine ⟨v, _⟩,
  rw [max_degree, ht],
  refl
end

/-- The maximum degree in the graph is at least the degree of any particular vertex. -/
lemma degree_le_max_degree [decidable_rel G.adj] (v : V) : G.degree v ≤ G.max_degree :=
begin
  obtain ⟨t, ht : _ = _⟩ := finset.max_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)),
  have := finset.le_max_of_mem (mem_image_of_mem _ (mem_univ v)) ht,
  rwa [max_degree, ht, option.get_or_else_some],
end

/--
In a graph, if `k` is at least the degree of every vertex, then it is at least the maximum
degree.
-/
lemma max_degree_le_of_forall_degree_le [decidable_rel G.adj] (k : ℕ)
  (h : ∀ v, G.degree v ≤ k) :
  G.max_degree ≤ k :=
begin
  by_cases hV : (univ : finset V).nonempty,
  { haveI : nonempty V := univ_nonempty_iff.mp hV,
    obtain ⟨v, hv⟩ := G.exists_maximal_degree_vertex,
    rw hv,
    apply h },
  { rw not_nonempty_iff_eq_empty at hV,
    rw [max_degree, hV, image_empty],
    exact zero_le k },
end

lemma degree_lt_card_verts [decidable_rel G.adj] (v : V) : G.degree v < fintype.card V :=
begin
  classical,
  apply finset.card_lt_card,
  rw finset.ssubset_iff,
  exact ⟨v, by simp, finset.subset_univ _⟩,
end

/--
The maximum degree of a nonempty graph is less than the number of vertices. Note that the assumption
that `V` is nonempty is necessary, as otherwise this would assert the existence of a natural less
than zero.
-/
lemma max_degree_lt_card_verts [decidable_rel G.adj] [nonempty V] : G.max_degree < fintype.card V :=
begin
  cases G.exists_maximal_degree_vertex with v hv,
  rw hv,
  apply G.degree_lt_card_verts v,
end

lemma card_common_neighbors_le_degree_left [decidable_rel G.adj] (v w : V) :
  fintype.card (G.common_neighbors v w) ≤ G.degree v :=
begin
  rw [←card_neighbor_set_eq_degree],
  exact set.card_le_of_subset (set.inter_subset_left _ _),
end

lemma card_common_neighbors_lt_card_verts [decidable_rel G.adj] (v w : V) :
  fintype.card (G.common_neighbors v w) < fintype.card V :=
nat.lt_of_le_of_lt (G.card_common_neighbors_le_degree_left _ _) (G.degree_lt_card_verts v)

/--
If the condition `G.adj v w` fails, then `card_common_neighbors_le_degree` is
the best we can do in general.
-/
lemma adj.card_common_neighbors_lt_degree {G : simple_graph V} [decidable_rel G.adj]
  {v w : V} (h : G.adj v w) :
  fintype.card (G.common_neighbors v w) < G.degree v :=
begin
  classical,
  erw [←set.to_finset_card],
  apply finset.card_lt_card,
  rw finset.ssubset_iff,
  use w,
  split,
  { rw set.mem_to_finset,
    apply not_mem_common_neighbors_right },
  { rw finset.insert_subset,
    split,
    { simpa, },
    { rw [neighbor_finset, ← set.subset_iff_to_finset_subset],
      apply common_neighbors_subset_neighbor_set } },

end

end finite

section complement

/-!
## Complement of a simple graph

This section contains definitions and lemmas concerning the complement of a simple graph.
-/

/--
We define `compl G` to be the `simple_graph V` such that no two adjacent vertices in `G`
are adjacent in the complement, and every nonadjacent pair of vertices is adjacent
(still ensuring that vertices are not adjacent to themselves.)
-/
def compl (G : simple_graph V) : simple_graph V :=
{ adj := λ v w, v ≠ w ∧ ¬G.adj v w,
  sym := λ v w ⟨hne, _⟩, ⟨hne.symm, by rwa edge_symm⟩,
  loopless := λ v ⟨hne, _⟩, false.elim (hne rfl) }

instance has_compl : has_compl (simple_graph V) :=
{ compl := compl }

@[simp]
lemma compl_adj (G : simple_graph V) (v w : V) : Gᶜ.adj v w ↔ v ≠ w ∧ ¬G.adj v w := iff.rfl

instance compl_adj_decidable (V : Type u) [decidable_eq V] (G : simple_graph V)
  [decidable_rel G.adj] : decidable_rel Gᶜ.adj := λ v w, and.decidable

@[simp]
lemma compl_compl (G : simple_graph V) : Gᶜᶜ = G :=
begin
  ext v w,
  split; simp only [compl_adj, not_and, not_not],
  { exact λ ⟨hne, h⟩, h hne },
  { intro h,
    simpa [G.ne_of_adj h], },
end

@[simp]
lemma compl_involutive : function.involutive (@compl V) := compl_compl

lemma compl_neighbor_set_disjoint (G : simple_graph V) (v : V) :
  disjoint (G.neighbor_set v) (Gᶜ.neighbor_set v) :=
begin
  rw set.disjoint_iff,
  rintro w ⟨h, h'⟩,
  rw [mem_neighbor_set, compl_adj] at h',
  exact h'.2 h,
end

lemma neighbor_set_union_compl_neighbor_set_eq (G : simple_graph V) (v : V) :
  G.neighbor_set v ∪ Gᶜ.neighbor_set v = {v}ᶜ :=
begin
  ext w,
  have h := @ne_of_adj _ G,
  simp_rw [set.mem_union, mem_neighbor_set, compl_adj, set.mem_compl_eq, set.mem_singleton_iff],
  tauto,
end

end complement

end simple_graph


/-
Copyright (c) 2022 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne, Kexing Ying
-/

import measure_theory.function.conditional_expectation.indicator
import measure_theory.function.uniform_integrable
import measure_theory.decomposition.radon_nikodym

/-!

# Conditional expectation of real-valued functions

This file proves some results regarding the conditional expectation of real-valued functions.

## Main results

* `measure_theory.rn_deriv_ae_eq_condexp`: the conditional expectation `μ[f | m]` is equal to the
  Radon-Nikodym derivative of `fμ` restricted on `m` with respect to `μ` restricted on `m`.
* `measure_theory.integrable.uniform_integrable_condexp`: the conditional expectation of a function
  form a uniformly integrable class.
* `measure_theory.condexp_strongly_measurable_mul`: the pull-out property of the conditional
  expectation.

-/

noncomputable theory
open topological_space measure_theory.Lp filter continuous_linear_map
open_locale nnreal ennreal topology big_operators measure_theory

namespace measure_theory

variables {α : Type*} {m m0 : measurable_space α} {μ : measure α}

lemma rn_deriv_ae_eq_condexp {hm : m ≤ m0} [hμm : sigma_finite (μ.trim hm)] {f : α → ℝ}
  (hf : integrable f μ) :
  signed_measure.rn_deriv ((μ.with_densityᵥ f).trim hm) (μ.trim hm) =ᵐ[μ] μ[f | m] :=
begin
  refine ae_eq_condexp_of_forall_set_integral_eq hm hf _ _ _,
  { exact λ _ _ _, (integrable_of_integrable_trim hm (signed_measure.integrable_rn_deriv
      ((μ.with_densityᵥ f).trim hm) (μ.trim hm))).integrable_on },
  { intros s hs hlt,
    conv_rhs { rw [← hf.with_densityᵥ_trim_eq_integral hm hs,
      ← signed_measure.with_densityᵥ_rn_deriv_eq ((μ.with_densityᵥ f).trim hm) (μ.trim hm)
        (hf.with_densityᵥ_trim_absolutely_continuous hm)], },
    rw [with_densityᵥ_apply
        (signed_measure.integrable_rn_deriv ((μ.with_densityᵥ f).trim hm) (μ.trim hm)) hs,
      ← set_integral_trim hm _ hs],
    exact (signed_measure.measurable_rn_deriv _ _).strongly_measurable },
  { exact strongly_measurable.ae_strongly_measurable'
      (signed_measure.measurable_rn_deriv _ _).strongly_measurable },
end

-- TODO: the following couple of lemmas should be generalized and proved using Jensen's inequality
-- for the conditional expectation (not in mathlib yet) .
lemma snorm_one_condexp_le_snorm (f : α → ℝ) :
  snorm (μ[f | m]) 1 μ ≤ snorm f 1 μ :=
begin
  by_cases hf : integrable f μ,
  swap, { rw [condexp_undef hf, snorm_zero], exact zero_le _ },
  by_cases hm : m ≤ m0,
  swap, { rw [condexp_of_not_le hm, snorm_zero], exact zero_le _ },
  by_cases hsig : sigma_finite (μ.trim hm),
  swap, { rw [condexp_of_not_sigma_finite hm hsig, snorm_zero], exact zero_le _ },
  calc snorm (μ[f | m]) 1 μ ≤ snorm (μ[|f| | m]) 1 μ :
  begin
    refine snorm_mono_ae _,
    filter_upwards [@condexp_mono _ m m0 _ _ _ _ _ _ _ _ hf hf.abs
        (@ae_of_all _ m0 _ μ (λ x, le_abs_self (f x) : ∀ x, f x ≤ |f x|)),
      eventually_le.trans (condexp_neg f).symm.le
        (@condexp_mono _ m m0 _ _ _ _ _ _ _  _ hf.neg hf.abs
        (@ae_of_all _ m0 _ μ (λ x, neg_le_abs_self (f x) : ∀ x, -f x ≤ |f x|)))] with x hx₁ hx₂,
    exact abs_le_abs hx₁ hx₂,
  end
    ... = snorm f 1 μ :
  begin
    rw [snorm_one_eq_lintegral_nnnorm, snorm_one_eq_lintegral_nnnorm,
      ← ennreal.to_real_eq_to_real (ne_of_lt integrable_condexp.2) (ne_of_lt hf.2),
      ← integral_norm_eq_lintegral_nnnorm
        (strongly_measurable_condexp.mono hm).ae_strongly_measurable,
      ← integral_norm_eq_lintegral_nnnorm hf.1],
    simp_rw [real.norm_eq_abs],
    rw ← @integral_condexp _ _ _ _ _ m m0 μ _ hm hsig hf.abs,
    refine integral_congr_ae _,
    have : 0 ≤ᵐ[μ] μ[|f| | m],
    { rw ← @condexp_zero α ℝ _ _ _ m m0 μ,
      exact condexp_mono (integrable_zero _ _ _) hf.abs
        (@ae_of_all _ m0 _ μ (λ x, abs_nonneg (f x) : ∀ x, 0 ≤ |f x|)) },
    filter_upwards [this] with x hx,
    exact abs_eq_self.2 hx
  end
end

lemma integral_abs_condexp_le (f : α → ℝ) :
  ∫ x, |μ[f | m] x| ∂μ ≤ ∫ x, |f x| ∂μ :=
begin
  by_cases hm : m ≤ m0,
  swap,
  { simp_rw [condexp_of_not_le hm, pi.zero_apply, abs_zero, integral_zero],
    exact integral_nonneg (λ x, abs_nonneg _) },
  by_cases hfint : integrable f μ,
  swap,
  { simp only [condexp_undef hfint, pi.zero_apply, abs_zero, integral_const,
      algebra.id.smul_eq_mul, mul_zero],
    exact integral_nonneg (λ x, abs_nonneg _) },
  rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae],
  { rw ennreal.to_real_le_to_real;
    simp_rw [← real.norm_eq_abs, of_real_norm_eq_coe_nnnorm],
    { rw [← snorm_one_eq_lintegral_nnnorm, ← snorm_one_eq_lintegral_nnnorm],
      exact snorm_one_condexp_le_snorm _ },
    { exact ne_of_lt integrable_condexp.2 },
    { exact ne_of_lt hfint.2 } },
  { exact eventually_of_forall (λ x, abs_nonneg _) },
  { simp_rw ← real.norm_eq_abs,
    exact hfint.1.norm },
  { exact eventually_of_forall (λ x, abs_nonneg _) },
  { simp_rw ← real.norm_eq_abs,
    exact (strongly_measurable_condexp.mono hm).ae_strongly_measurable.norm }
end

lemma set_integral_abs_condexp_le {s : set α} (hs : measurable_set[m] s) (f : α → ℝ) :
  ∫ x in s, |μ[f | m] x| ∂μ ≤ ∫ x in s, |f x| ∂μ :=
begin
  by_cases hnm : m ≤ m0,
  swap,
  { simp_rw [condexp_of_not_le hnm, pi.zero_apply, abs_zero, integral_zero],
    exact integral_nonneg (λ x, abs_nonneg _) },
  by_cases hfint : integrable f μ,
  swap,
  { simp only [condexp_undef hfint, pi.zero_apply, abs_zero, integral_const,
      algebra.id.smul_eq_mul, mul_zero],
    exact integral_nonneg (λ x, abs_nonneg _) },
  have : ∫ x in s, |μ[f | m] x| ∂μ = ∫ x, |μ[s.indicator f | m] x| ∂μ,
  { rw ← integral_indicator,
    swap, { exact hnm _ hs },
    refine integral_congr_ae _,
    have : (λ x, |μ[s.indicator f | m] x|) =ᵐ[μ] λ x, |s.indicator (μ[f | m]) x| :=
      eventually_eq.fun_comp (condexp_indicator hfint hs) _,
    refine eventually_eq.trans (eventually_of_forall $ λ x, _) this.symm,
    rw [← real.norm_eq_abs, norm_indicator_eq_indicator_norm],
    refl },
  rw [this, ← integral_indicator],
  swap, { exact hnm _ hs },
  refine (integral_abs_condexp_le _).trans (le_of_eq $ integral_congr_ae $
    eventually_of_forall $ λ x, _),
  rw [← real.norm_eq_abs, norm_indicator_eq_indicator_norm],
  refl,
end

/-- If the real valued function `f` is bounded almost everywhere by `R`, then so is its conditional
expectation. -/
lemma ae_bdd_condexp_of_ae_bdd {R : ℝ≥0} {f : α → ℝ}
  (hbdd : ∀ᵐ x ∂μ, |f x| ≤ R) :
  ∀ᵐ x ∂μ, |μ[f | m] x| ≤ R :=
begin
  by_cases hnm : m ≤ m0,
  swap,
  { simp_rw [condexp_of_not_le hnm, pi.zero_apply, abs_zero],
    refine eventually_of_forall (λ x, R.coe_nonneg) },
  by_cases hfint : integrable f μ,
  swap,
  { simp_rw [condexp_undef hfint],
    filter_upwards [hbdd] with x hx,
    rw [pi.zero_apply, abs_zero],
    exact (abs_nonneg _).trans hx },
  by_contra h,
  change μ _ ≠ 0 at h,
  simp only [← zero_lt_iff, set.compl_def, set.mem_set_of_eq, not_le] at h,
  suffices : (μ {x | ↑R < |μ[f | m] x|}).to_real * ↑R < (μ {x | ↑R < |μ[f | m] x|}).to_real * ↑R,
  { exact this.ne rfl },
  refine lt_of_lt_of_le (set_integral_gt_gt R.coe_nonneg _ _ h.ne.symm) _,
  { simp_rw [← real.norm_eq_abs],
    exact (strongly_measurable_condexp.mono hnm).measurable.norm },
  { exact integrable_condexp.abs.integrable_on },
  refine (set_integral_abs_condexp_le _ _).trans _,
  { simp_rw [← real.norm_eq_abs],
    exact @measurable_set_lt _ _ _ _ _ m _ _ _ _ _ measurable_const
      strongly_measurable_condexp.norm.measurable },
  simp only [← smul_eq_mul, ← set_integral_const, nnreal.val_eq_coe,
    is_R_or_C.coe_real_eq_id, id.def],
  refine set_integral_mono_ae hfint.abs.integrable_on _ _,
  { refine ⟨ae_strongly_measurable_const, lt_of_le_of_lt _
      (integrable_condexp.integrable_on : integrable_on (μ[f | m]) {x | ↑R < |μ[f | m] x|} μ).2⟩,
    refine set_lintegral_mono (measurable.nnnorm _).coe_nnreal_ennreal
      (strongly_measurable_condexp.mono hnm).measurable.nnnorm.coe_nnreal_ennreal (λ x hx, _),
    { exact measurable_const },
    { rw [ennreal.coe_le_coe, real.nnnorm_of_nonneg R.coe_nonneg],
      exact subtype.mk_le_mk.2 (le_of_lt hx) } },
  { exact hbdd },
end

/-- Given a integrable function `g`, the conditional expectations of `g` with respect to
a sequence of sub-σ-algebras is uniformly integrable. -/
lemma integrable.uniform_integrable_condexp {ι : Type*} [is_finite_measure μ]
  {g : α → ℝ} (hint : integrable g μ) {ℱ : ι → measurable_space α} (hℱ : ∀ i, ℱ i ≤ m0) :
  uniform_integrable (λ i, μ[g | ℱ i]) 1 μ :=
begin
  have hmeas : ∀ n, ∀ C, measurable_set {x | C ≤ ‖μ[g | ℱ n] x‖₊} :=
    λ n C, measurable_set_le measurable_const
      (strongly_measurable_condexp.mono (hℱ n)).measurable.nnnorm,
  have hg : mem_ℒp g 1 μ := mem_ℒp_one_iff_integrable.2 hint,
  refine uniform_integrable_of le_rfl ennreal.one_ne_top
    (λ n, (strongly_measurable_condexp.mono (hℱ n)).ae_strongly_measurable) (λ ε hε, _),
  by_cases hne : snorm g 1 μ = 0,
  { rw snorm_eq_zero_iff hg.1 one_ne_zero at hne,
    refine ⟨0, λ n, (le_of_eq $ (snorm_eq_zero_iff
      ((strongly_measurable_condexp.mono (hℱ n)).ae_strongly_measurable.indicator (hmeas n 0))
      one_ne_zero).2 _).trans (zero_le _)⟩,
    filter_upwards [@condexp_congr_ae _ _ _ _ _ (ℱ n) m0 μ _ _ hne] with x hx,
    simp only [zero_le', set.set_of_true, set.indicator_univ, pi.zero_apply, hx, condexp_zero] },
  obtain ⟨δ, hδ, h⟩ := hg.snorm_indicator_le μ le_rfl ennreal.one_ne_top hε,
  set C : ℝ≥0 := ⟨δ, hδ.le⟩⁻¹ * (snorm g 1 μ).to_nnreal with hC,
  have hCpos : 0 < C :=
    mul_pos (inv_pos.2 hδ) (ennreal.to_nnreal_pos hne hg.snorm_lt_top.ne),
  have : ∀ n, μ {x : α | C ≤ ‖μ[g | ℱ n] x‖₊} ≤ ennreal.of_real δ,
  { intro n,
    have := mul_meas_ge_le_pow_snorm' μ one_ne_zero ennreal.one_ne_top
      ((@strongly_measurable_condexp _ _ _ _ _ (ℱ n) _ μ g).mono
        (hℱ n)).ae_strongly_measurable C,
    rw [ennreal.one_to_real, ennreal.rpow_one, ennreal.rpow_one, mul_comm,
      ← ennreal.le_div_iff_mul_le (or.inl (ennreal.coe_ne_zero.2 hCpos.ne.symm))
        (or.inl ennreal.coe_lt_top.ne)] at this,
    simp_rw [ennreal.coe_le_coe] at this,
    refine this.trans _,
    rw [ennreal.div_le_iff_le_mul (or.inl (ennreal.coe_ne_zero.2 hCpos.ne.symm))
        (or.inl ennreal.coe_lt_top.ne), hC, nonneg.inv_mk, ennreal.coe_mul,
      ennreal.coe_to_nnreal hg.snorm_lt_top.ne, ← mul_assoc, ← ennreal.of_real_eq_coe_nnreal,
      ← ennreal.of_real_mul hδ.le, mul_inv_cancel hδ.ne.symm, ennreal.of_real_one, one_mul],
    exact snorm_one_condexp_le_snorm _ },
  refine ⟨C, λ n, le_trans _ (h {x : α | C ≤ ‖μ[g | ℱ n] x‖₊} (hmeas n C) (this n))⟩,
  have hmeasℱ : measurable_set[ℱ n] {x : α | C ≤ ‖μ[g | ℱ n] x‖₊} :=
    @measurable_set_le _ _ _ _ _ (ℱ n) _ _ _ _ _ measurable_const
      (@measurable.nnnorm _ _ _ _ _ (ℱ n) _ strongly_measurable_condexp.measurable),
  rw ← snorm_congr_ae (condexp_indicator hint hmeasℱ),
  exact snorm_one_condexp_le_snorm _,
end

section pull_out
-- TODO: this section could be generalized beyond multiplication, to any bounded bilinear map.

/-- Auxiliary lemma for `condexp_measurable_mul`. -/
lemma condexp_strongly_measurable_simple_func_mul (hm : m ≤ m0)
  (f : @simple_func α m ℝ) {g : α → ℝ} (hg : integrable g μ) :
  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
begin
  have : ∀ s c (f : α → ℝ), set.indicator s (function.const α c) * f = s.indicator (c • f),
  { intros s c f,
    ext1 x,
    by_cases hx : x ∈ s,
    { simp only [hx, pi.mul_apply, set.indicator_of_mem, pi.smul_apply, algebra.id.smul_eq_mul] },
    { simp only [hx, pi.mul_apply, set.indicator_of_not_mem, not_false_iff, zero_mul], }, },
  refine @simple_func.induction _ _ m _ _ (λ c s hs, _) (λ g₁ g₂ h_disj h_eq₁ h_eq₂, _) f,
  { simp only [simple_func.const_zero, simple_func.coe_piecewise, simple_func.coe_const,
      simple_func.coe_zero, set.piecewise_eq_indicator],
    rw [this, this],
    refine (condexp_indicator (hg.smul c) hs).trans _,
    filter_upwards [@condexp_smul α ℝ ℝ _ _ _ _ _ m m0 μ c g] with x hx,
    classical,
    simp_rw [set.indicator_apply, hx], },
  { have h_add := @simple_func.coe_add _ _ m _ g₁ g₂,
    calc μ[⇑(g₁ + g₂) * g|m] =ᵐ[μ] μ[(⇑g₁ + ⇑g₂) * g|m] :
      by { refine condexp_congr_ae (eventually_eq.mul _ eventually_eq.rfl), rw h_add, }
    ... =ᵐ[μ] μ[⇑g₁ * g|m] + μ[⇑g₂ * g|m] :
      by { rw add_mul, exact condexp_add (hg.simple_func_mul' hm _) (hg.simple_func_mul' hm _), }
    ... =ᵐ[μ] ⇑g₁ * μ[g|m] + ⇑g₂ * μ[g|m] : eventually_eq.add h_eq₁ h_eq₂
    ... =ᵐ[μ] ⇑(g₁ + g₂) * μ[g|m] : by rw [h_add, add_mul], },
end

lemma condexp_strongly_measurable_mul_of_bound (hm : m ≤ m0) [is_finite_measure μ]
  {f g : α → ℝ} (hf : strongly_measurable[m] f) (hg : integrable g μ) (c : ℝ)
  (hf_bound : ∀ᵐ x ∂μ, ‖f x‖ ≤ c) :
  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
begin
  let fs := hf.approx_bounded c,
  have hfs_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, fs n x) at_top (𝓝 (f x)),
    from hf.tendsto_approx_bounded_ae hf_bound,
  by_cases hμ : μ = 0,
  { simp only [hμ, ae_zero], },
  haveI : μ.ae.ne_bot, by simp only [hμ, ae_ne_bot, ne.def, not_false_iff],
  have hc : 0 ≤ c,
  { have h_exists : ∃ x, ‖f x‖ ≤ c := eventually.exists hf_bound,
    exact (norm_nonneg _).trans h_exists.some_spec, },
  have hfs_bound : ∀ n x, ‖fs n x‖ ≤ c := hf.norm_approx_bounded_le hc,
  have hn_eq : ∀ n, μ[fs n * g | m] =ᵐ[μ] fs n * μ[g | m],
    from λ n, condexp_strongly_measurable_simple_func_mul hm _ hg,
  have : μ[f * μ[g|m]|m] = f * μ[g|m],
  { refine condexp_of_strongly_measurable hm (hf.mul strongly_measurable_condexp) _,
    exact integrable_condexp.bdd_mul' ((hf.mono hm).ae_strongly_measurable) hf_bound, },
  rw ← this,
  refine tendsto_condexp_unique (λ n x, fs n x * g x) (λ n x, fs n x * μ[g|m] x) (f * g)
    (f * μ[g|m]) _ _ _ _ (λ x, c * ‖g x‖) _ (λ x, c * ‖μ[g|m] x‖) _ _ _ _,
  { exact λ n, hg.bdd_mul'
      ((simple_func.strongly_measurable (fs n)).mono hm).ae_strongly_measurable
      (eventually_of_forall (hfs_bound n)), },
  { exact λ n, integrable_condexp.bdd_mul'
      ((simple_func.strongly_measurable (fs n)).mono hm).ae_strongly_measurable
      (eventually_of_forall (hfs_bound n)), },
  { filter_upwards [hfs_tendsto] with x hx,
    rw pi.mul_apply,
    exact tendsto.mul hx tendsto_const_nhds, },
  { filter_upwards [hfs_tendsto] with x hx,
    rw pi.mul_apply,
    exact tendsto.mul hx tendsto_const_nhds, },
  { exact hg.norm.const_mul c, },
  { exact integrable_condexp.norm.const_mul c, },
  { refine λ n, eventually_of_forall (λ x, _),
    exact (norm_mul_le _ _).trans (mul_le_mul_of_nonneg_right (hfs_bound n x) (norm_nonneg _)), },
  { refine λ n, eventually_of_forall (λ x, _),
    exact (norm_mul_le _ _).trans (mul_le_mul_of_nonneg_right (hfs_bound n x) (norm_nonneg _)), },
  { intros n,
    simp_rw ← pi.mul_apply,
    refine (condexp_strongly_measurable_simple_func_mul hm _ hg).trans _,
    rw condexp_of_strongly_measurable hm
      ((simple_func.strongly_measurable _).mul strongly_measurable_condexp) _,
    { apply_instance, },
    { apply_instance, },
    exact integrable_condexp.bdd_mul'
      ((simple_func.strongly_measurable (fs n)).mono hm).ae_strongly_measurable
      (eventually_of_forall (hfs_bound n)), },
end

lemma condexp_strongly_measurable_mul_of_bound₀ (hm : m ≤ m0) [is_finite_measure μ]
  {f g : α → ℝ} (hf : ae_strongly_measurable' m f μ) (hg : integrable g μ) (c : ℝ)
  (hf_bound : ∀ᵐ x ∂μ, ‖f x‖ ≤ c) :
  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
begin
  have : μ[f * g | m] =ᵐ[μ] μ[hf.mk f * g | m],
    from condexp_congr_ae (eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl),
  refine this.trans _,
  have : f * μ[g | m] =ᵐ[μ] hf.mk f * μ[g | m] := eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl,
  refine eventually_eq.trans _ this.symm,
  refine condexp_strongly_measurable_mul_of_bound hm hf.strongly_measurable_mk hg c _,
  filter_upwards [hf_bound, hf.ae_eq_mk] with x hxc hx_eq,
  rw ← hx_eq,
  exact hxc,
end

/-- Pull-out property of the conditional expectation. -/
lemma condexp_strongly_measurable_mul {f g : α → ℝ} (hf : strongly_measurable[m] f)
  (hfg : integrable (f * g) μ) (hg : integrable g μ) :
  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
begin
  by_cases hm : m ≤ m0, swap, { simp_rw condexp_of_not_le hm, rw mul_zero, },
  by_cases hμm : sigma_finite (μ.trim hm),
  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, rw mul_zero, },
  haveI : sigma_finite (μ.trim hm) := hμm,
  obtain ⟨sets, sets_prop, h_univ⟩ := hf.exists_spanning_measurable_set_norm_le hm μ,
  simp_rw forall_and_distrib at sets_prop,
  obtain ⟨h_meas, h_finite, h_norm⟩ := sets_prop,

  suffices : ∀ n, ∀ᵐ x ∂μ, x ∈ sets n → μ[f * g|m] x = f x * μ[g|m] x,
  { rw ← ae_all_iff at this,
    filter_upwards [this] with x hx,
    rw pi.mul_apply,
    obtain ⟨i, hi⟩ : ∃ i, x ∈ sets i,
    { have h_mem : x ∈ ⋃ i, sets i,
      { rw h_univ, exact set.mem_univ _, },
      simpa using h_mem, },
    exact hx i hi, },
  refine λ n, ae_imp_of_ae_restrict _,
  suffices : (μ.restrict (sets n))[f * g | m]
    =ᵐ[μ.restrict (sets n)] f * (μ.restrict (sets n))[g | m],
  { simp_rw ← pi.mul_apply,
    refine (condexp_restrict_ae_eq_restrict hm (h_meas n) hfg).symm.trans _,
    exact this.trans (eventually_eq.rfl.mul (condexp_restrict_ae_eq_restrict hm (h_meas n) hg)), },
  suffices : (μ.restrict (sets n))[((sets n).indicator f) * g | m]
    =ᵐ[μ.restrict (sets n)] ((sets n).indicator f) * (μ.restrict (sets n))[g | m],
  { refine eventually_eq.trans _ (this.trans _),
    { exact condexp_congr_ae
        ((indicator_ae_eq_restrict (hm _ (h_meas n))).symm.mul eventually_eq.rfl), },
    { exact (indicator_ae_eq_restrict (hm _ (h_meas n))).mul eventually_eq.rfl, }, },
  haveI : is_finite_measure (μ.restrict (sets n)),
  { constructor,
    rw measure.restrict_apply_univ,
    exact h_finite n, },
  refine condexp_strongly_measurable_mul_of_bound hm (hf.indicator (h_meas n)) hg.integrable_on n _,
  refine eventually_of_forall (λ x, _),
  by_cases hxs : x ∈ sets n,
  { simp only [hxs, set.indicator_of_mem],
    exact h_norm n x hxs, },
  { simp only [hxs, set.indicator_of_not_mem, not_false_iff, _root_.norm_zero, nat.cast_nonneg], },
end

/-- Pull-out property of the conditional expectation. -/
lemma condexp_strongly_measurable_mul₀ {f g : α → ℝ} (hf : ae_strongly_measurable' m f μ)
  (hfg : integrable (f * g) μ) (hg : integrable g μ) :
  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
begin
  have : μ[f * g | m] =ᵐ[μ] μ[hf.mk f * g | m],
    from condexp_congr_ae (eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl),
  refine this.trans _,
  have : f * μ[g | m] =ᵐ[μ] hf.mk f * μ[g | m] := eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl,
  refine eventually_eq.trans _ this.symm,
  refine condexp_strongly_measurable_mul hf.strongly_measurable_mk _ hg,
  refine (integrable_congr _).mp hfg,
  exact eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl,
end

end pull_out

end measure_theory


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Extra lemmas about intervals

This file contains lemmas about intervals that cannot be included into `data.set.intervals.basic`
because this would create an `import` cycle. Namely, lemmas in this file can use definitions
from `data.set.lattice`, including `disjoint`.
-/

namespace set

@[simp] theorem Iic_disjoint_Ioi {α : Type u} [preorder α] {a : α} {b : α} (h : a ≤ b) :
    disjoint (Iic a) (Ioi b) :=
  sorry

@[simp] theorem Iic_disjoint_Ioc {α : Type u} [preorder α] {a : α} {b : α} {c : α} (h : a ≤ b) :
    disjoint (Iic a) (Ioc b c) :=
  disjoint.mono (le_refl (Iic a)) (fun (_x : α) => and.left) (Iic_disjoint_Ioi h)

@[simp] theorem Ioc_disjoint_Ioc_same {α : Type u} [preorder α] {a : α} {b : α} {c : α} :
    disjoint (Ioc a b) (Ioc b c) :=
  disjoint.mono (fun (_x : α) => and.right) (le_refl (Ioc b c)) (Iic_disjoint_Ioc (le_refl b))

@[simp] theorem Ico_disjoint_Ico_same {α : Type u} [preorder α] {a : α} {b : α} {c : α} :
    disjoint (Ico a b) (Ico b c) :=
  fun (x : α) (hx : x ∈ Ico a b ⊓ Ico b c) =>
    not_le_of_lt (and.right (and.left hx)) (and.left (and.right hx))

@[simp] theorem Ico_disjoint_Ico {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α} {b₂ : α} :
    disjoint (Ico a₁ a₂) (Ico b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
  sorry

@[simp] theorem Ioc_disjoint_Ioc {α : Type u} [linear_order α] {a₁ : α} {a₂ : α} {b₁ : α} {b₂ : α} :
    disjoint (Ioc a₁ a₂) (Ioc b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
  sorry

/-- If two half-open intervals are disjoint and the endpoint of one lies in the other,
  then it must be equal to the endpoint of the other. -/
theorem eq_of_Ico_disjoint {α : Type u} [linear_order α] {x₁ : α} {x₂ : α} {y₁ : α} {y₂ : α}
    (h : disjoint (Ico x₁ x₂) (Ico y₁ y₂)) (hx : x₁ < x₂) (h2 : x₂ ∈ Ico y₁ y₂) : y₁ = x₂ :=
  sorry

end Mathlib