/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.semicontinuous
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.IndicatorFunction
import Mathlib.Topology.ContinuousOn
import Mathlib.Topology.Instances.ENNReal

/-!
# Semicontinuous maps

A function `f` from a topological space `α` to an ordered space `β` is lower semicontinuous at a
point `x` if, for any `y < f x`, for any `x'` close enough to `x`, one has `f x' > y`. In other
words, `f` can jump up, but it can not jump down.

Upper semicontinuous functions are defined similarly.

This file introduces these notions, and a basic API around them mimicking the API for continuous
functions.

## Main definitions and results

We introduce 4 definitions related to lower semicontinuity:
* `LowerSemicontinuousWithinAt f s x`
* `LowerSemicontinuousAt f x`
* `LowerSemicontinuousOn f s`
* `LowerSemicontinuous f`

We build a basic API using dot notation around these notions, and we prove that
* constant functions are lower semicontinuous;
* `indicator s (λ _, y)` is lower semicontinuous when `s` is open and `0 ≤ y`, or when `s` is closed
  and `y ≤ 0`;
* continuous functions are lower semicontinuous;
* composition with a continuous monotone functions maps lower semicontinuous functions to lower
  semicontinuous functions. If the function is anti-monotone, it instead maps lower semicontinuous
  functions to upper semicontinuous functions;
* a sum of two (or finitely many) lower semicontinuous functions is lower semicontinuous;
* a supremum of a family of lower semicontinuous functions is lower semicontinuous;
* An infinite sum of `ℝ≥0∞`-valued lower semicontinuous functions is lower semicontinuous.

Similar results are stated and proved for upper semicontinuity.

We also prove that a function is continuous if and only if it is both lower and upper
semicontinuous.

## Implementation details

All the nontrivial results for upper semicontinuous functions are deduced from the corresponding
ones for lower semicontinuous functions using `OrderDual`.

-/

open Topology BigOperators ENNReal

open Set Function Filter

variable {α : Type _} [TopologicalSpace α] {β : Type _} [Preorder β] {f g : α → β} {x : α}
  {s t : Set α} {y z : β}

/-! ### Main definitions -/

/-- A real function `f` is lower semicontinuous at `x` within a set `s` if, for any `ε > 0`, for all
`x'` close enough to `x` in  `s`, then `f x'` is at least `f x - ε`. We formulate this in a general
preordered space, using an arbitrary `y < f x` instead of `f x - ε`. -/
def LowerSemicontinuousWithinAt (f : α → β) (s : Set α) (x : α) :=
  ∀ y < f x, ∀ᶠ x' in 𝓝[s] x, y < f x'
#align lower_semicontinuous_within_at LowerSemicontinuousWithinAt

/-- A real function `f` is lower semicontinuous on a set `s` if, for any `ε > 0`, for any `x ∈ s`,
for all `x'` close enough to `x` in `s`, then `f x'` is at least `f x - ε`. We formulate this in
a general preordered space, using an arbitrary `y < f x` instead of `f x - ε`.-/
def LowerSemicontinuousOn (f : α → β) (s : Set α) :=
  ∀ x ∈ s, LowerSemicontinuousWithinAt f s x
#align lower_semicontinuous_on LowerSemicontinuousOn

/-- A real function `f` is lower semicontinuous at `x` if, for any `ε > 0`, for all `x'` close
enough to `x`, then `f x'` is at least `f x - ε`. We formulate this in a general preordered space,
using an arbitrary `y < f x` instead of `f x - ε`. -/
def LowerSemicontinuousAt (f : α → β) (x : α) :=
  ∀ y < f x, ∀ᶠ x' in 𝓝 x, y < f x'
#align lower_semicontinuous_at LowerSemicontinuousAt

/-- A real function `f` is lower semicontinuous if, for any `ε > 0`, for any `x`, for all `x'` close
enough to `x`, then `f x'` is at least `f x - ε`. We formulate this in a general preordered space,
using an arbitrary `y < f x` instead of `f x - ε`. -/
def LowerSemicontinuous (f : α → β) :=
  ∀ x, LowerSemicontinuousAt f x
#align lower_semicontinuous LowerSemicontinuous

/-- A real function `f` is upper semicontinuous at `x` within a set `s` if, for any `ε > 0`, for all
`x'` close enough to `x` in  `s`, then `f x'` is at most `f x + ε`. We formulate this in a general
preordered space, using an arbitrary `y > f x` instead of `f x + ε`. -/
def UpperSemicontinuousWithinAt (f : α → β) (s : Set α) (x : α) :=
  ∀ y, f x < y → ∀ᶠ x' in 𝓝[s] x, f x' < y
#align upper_semicontinuous_within_at UpperSemicontinuousWithinAt

/-- A real function `f` is upper semicontinuous on a set `s` if, for any `ε > 0`, for any `x ∈ s`,
for all `x'` close enough to `x` in `s`, then `f x'` is at most `f x + ε`. We formulate this in a
general preordered space, using an arbitrary `y > f x` instead of `f x + ε`.-/
def UpperSemicontinuousOn (f : α → β) (s : Set α) :=
  ∀ x ∈ s, UpperSemicontinuousWithinAt f s x
#align upper_semicontinuous_on UpperSemicontinuousOn

/-- A real function `f` is upper semicontinuous at `x` if, for any `ε > 0`, for all `x'` close
enough to `x`, then `f x'` is at most `f x + ε`. We formulate this in a general preordered space,
using an arbitrary `y > f x` instead of `f x + ε`. -/
def UpperSemicontinuousAt (f : α → β) (x : α) :=
  ∀ y, f x < y → ∀ᶠ x' in 𝓝 x, f x' < y
#align upper_semicontinuous_at UpperSemicontinuousAt

/-- A real function `f` is upper semicontinuous if, for any `ε > 0`, for any `x`, for all `x'`
close enough to `x`, then `f x'` is at most `f x + ε`. We formulate this in a general preordered
space, using an arbitrary `y > f x` instead of `f x + ε`.-/
def UpperSemicontinuous (f : α → β) :=
  ∀ x, UpperSemicontinuousAt f x
#align upper_semicontinuous UpperSemicontinuous

/-!
### Lower semicontinuous functions
-/

/-! #### Basic dot notation interface for lower semicontinuity -/

theorem LowerSemicontinuousWithinAt.mono (h : LowerSemicontinuousWithinAt f s x) (hst : t ⊆ s) :
    LowerSemicontinuousWithinAt f t x := fun y hy =>
  Filter.Eventually.filter_mono (nhdsWithin_mono _ hst) (h y hy)
#align lower_semicontinuous_within_at.mono LowerSemicontinuousWithinAt.mono

theorem lowerSemicontinuousWithinAt_univ_iff :
    LowerSemicontinuousWithinAt f univ x ↔ LowerSemicontinuousAt f x := by
  simp [LowerSemicontinuousWithinAt, LowerSemicontinuousAt, nhdsWithin_univ]
#align lower_semicontinuous_within_at_univ_iff lowerSemicontinuousWithinAt_univ_iff

theorem LowerSemicontinuousAt.lowerSemicontinuousWithinAt (s : Set α)
    (h : LowerSemicontinuousAt f x) : LowerSemicontinuousWithinAt f s x := fun y hy =>
  Filter.Eventually.filter_mono nhdsWithin_le_nhds (h y hy)
#align lower_semicontinuous_at.lower_semicontinuous_within_at LowerSemicontinuousAt.lowerSemicontinuousWithinAt

theorem LowerSemicontinuousOn.lowerSemicontinuousWithinAt (h : LowerSemicontinuousOn f s)
    (hx : x ∈ s) : LowerSemicontinuousWithinAt f s x :=
  h x hx
#align lower_semicontinuous_on.lower_semicontinuous_within_at LowerSemicontinuousOn.lowerSemicontinuousWithinAt

theorem LowerSemicontinuousOn.mono (h : LowerSemicontinuousOn f s) (hst : t ⊆ s) :
    LowerSemicontinuousOn f t := fun x hx => (h x (hst hx)).mono hst
#align lower_semicontinuous_on.mono LowerSemicontinuousOn.mono

theorem lowerSemicontinuousOn_univ_iff : LowerSemicontinuousOn f univ ↔ LowerSemicontinuous f := by
  simp [LowerSemicontinuousOn, LowerSemicontinuous, lowerSemicontinuousWithinAt_univ_iff]
#align lower_semicontinuous_on_univ_iff lowerSemicontinuousOn_univ_iff

theorem LowerSemicontinuous.lowerSemicontinuousAt (h : LowerSemicontinuous f) (x : α) :
    LowerSemicontinuousAt f x :=
  h x
#align lower_semicontinuous.lower_semicontinuous_at LowerSemicontinuous.lowerSemicontinuousAt

theorem LowerSemicontinuous.lowerSemicontinuousWithinAt (h : LowerSemicontinuous f) (s : Set α)
    (x : α) : LowerSemicontinuousWithinAt f s x :=
  (h x).lowerSemicontinuousWithinAt s
#align lower_semicontinuous.lower_semicontinuous_within_at LowerSemicontinuous.lowerSemicontinuousWithinAt

theorem LowerSemicontinuous.lowerSemicontinuousOn (h : LowerSemicontinuous f) (s : Set α) :
    LowerSemicontinuousOn f s := fun x _hx => h.lowerSemicontinuousWithinAt s x
#align lower_semicontinuous.lower_semicontinuous_on LowerSemicontinuous.lowerSemicontinuousOn

/-! #### Constants -/

theorem lowerSemicontinuousWithinAt_const : LowerSemicontinuousWithinAt (fun _x => z) s x :=
  fun _y hy => Filter.eventually_of_forall fun _x => hy
#align lower_semicontinuous_within_at_const lowerSemicontinuousWithinAt_const

theorem lowerSemicontinuousAt_const : LowerSemicontinuousAt (fun _x => z) x := fun _y hy =>
  Filter.eventually_of_forall fun _x => hy
#align lower_semicontinuous_at_const lowerSemicontinuousAt_const

theorem lowerSemicontinuousOn_const : LowerSemicontinuousOn (fun _x => z) s := fun _x _hx =>
  lowerSemicontinuousWithinAt_const
#align lower_semicontinuous_on_const lowerSemicontinuousOn_const

theorem lowerSemicontinuous_const : LowerSemicontinuous fun _x : α => z := fun _x =>
  lowerSemicontinuousAt_const
#align lower_semicontinuous_const lowerSemicontinuous_const

/-! #### Indicators -/

section

variable [Zero β]

theorem IsOpen.lowerSemicontinuous_indicator (hs : IsOpen s) (hy : 0 ≤ y) :
    LowerSemicontinuous (indicator s fun _x => y) := by
  intro x z hz
  by_cases h : x ∈ s <;> simp [h] at hz
  · filter_upwards [hs.mem_nhds h]
    simp (config := { contextual := true }) [hz]
  · refine Filter.eventually_of_forall fun x' => ?_
    by_cases h' : x' ∈ s <;> simp [h', hz.trans_le hy, hz]
#align is_open.lower_semicontinuous_indicator IsOpen.lowerSemicontinuous_indicator

theorem IsOpen.lowerSemicontinuousOn_indicator (hs : IsOpen s) (hy : 0 ≤ y) :
    LowerSemicontinuousOn (indicator s fun _x => y) t :=
  (hs.lowerSemicontinuous_indicator hy).lowerSemicontinuousOn t
#align is_open.lower_semicontinuous_on_indicator IsOpen.lowerSemicontinuousOn_indicator

theorem IsOpen.lowerSemicontinuousAt_indicator (hs : IsOpen s) (hy : 0 ≤ y) :
    LowerSemicontinuousAt (indicator s fun _x => y) x :=
  (hs.lowerSemicontinuous_indicator hy).lowerSemicontinuousAt x
#align is_open.lower_semicontinuous_at_indicator IsOpen.lowerSemicontinuousAt_indicator

theorem IsOpen.lowerSemicontinuousWithinAt_indicator (hs : IsOpen s) (hy : 0 ≤ y) :
    LowerSemicontinuousWithinAt (indicator s fun _x => y) t x :=
  (hs.lowerSemicontinuous_indicator hy).lowerSemicontinuousWithinAt t x
#align is_open.lower_semicontinuous_within_at_indicator IsOpen.lowerSemicontinuousWithinAt_indicator

theorem IsClosed.lowerSemicontinuous_indicator (hs : IsClosed s) (hy : y ≤ 0) :
    LowerSemicontinuous (indicator s fun _x => y) := by
  intro x z hz
  by_cases h : x ∈ s <;> simp [h] at hz
  · refine Filter.eventually_of_forall fun x' => ?_
    by_cases h' : x' ∈ s <;> simp [h', hz, hz.trans_le hy]
  · filter_upwards [hs.isOpen_compl.mem_nhds h]
    simp (config := { contextual := true }) [hz]
#align is_closed.lower_semicontinuous_indicator IsClosed.lowerSemicontinuous_indicator

theorem IsClosed.lowerSemicontinuousOn_indicator (hs : IsClosed s) (hy : y ≤ 0) :
    LowerSemicontinuousOn (indicator s fun _x => y) t :=
  (hs.lowerSemicontinuous_indicator hy).lowerSemicontinuousOn t
#align is_closed.lower_semicontinuous_on_indicator IsClosed.lowerSemicontinuousOn_indicator

theorem IsClosed.lowerSemicontinuousAt_indicator (hs : IsClosed s) (hy : y ≤ 0) :
    LowerSemicontinuousAt (indicator s fun _x => y) x :=
  (hs.lowerSemicontinuous_indicator hy).lowerSemicontinuousAt x
#align is_closed.lower_semicontinuous_at_indicator IsClosed.lowerSemicontinuousAt_indicator

theorem IsClosed.lowerSemicontinuousWithinAt_indicator (hs : IsClosed s) (hy : y ≤ 0) :
    LowerSemicontinuousWithinAt (indicator s fun _x => y) t x :=
  (hs.lowerSemicontinuous_indicator hy).lowerSemicontinuousWithinAt t x
#align is_closed.lower_semicontinuous_within_at_indicator IsClosed.lowerSemicontinuousWithinAt_indicator

end

/-! #### Relationship with continuity -/

theorem lowerSemicontinuous_iff_isOpen_preimage :
    LowerSemicontinuous f ↔ ∀ y, IsOpen (f ⁻¹' Ioi y) :=
  ⟨fun H y => isOpen_iff_mem_nhds.2 fun x hx => H x y hx, fun H _x y y_lt =>
    IsOpen.mem_nhds (H y) y_lt⟩
#align lower_semicontinuous_iff_is_open_preimage lowerSemicontinuous_iff_isOpen_preimage

theorem LowerSemicontinuous.isOpen_preimage (hf : LowerSemicontinuous f) (y : β) :
    IsOpen (f ⁻¹' Ioi y) :=
  lowerSemicontinuous_iff_isOpen_preimage.1 hf y
#align lower_semicontinuous.is_open_preimage LowerSemicontinuous.isOpen_preimage

section

variable {γ : Type _} [LinearOrder γ]

theorem lowerSemicontinuous_iff_isClosed_preimage {f : α → γ} :
    LowerSemicontinuous f ↔ ∀ y, IsClosed (f ⁻¹' Iic y) := by
  rw [lowerSemicontinuous_iff_isOpen_preimage]
  simp only [← isOpen_compl_iff, ← preimage_compl, compl_Iic]
#align lower_semicontinuous_iff_is_closed_preimage lowerSemicontinuous_iff_isClosed_preimage

theorem LowerSemicontinuous.isClosed_preimage {f : α → γ} (hf : LowerSemicontinuous f) (y : γ) :
    IsClosed (f ⁻¹' Iic y) :=
  lowerSemicontinuous_iff_isClosed_preimage.1 hf y
#align lower_semicontinuous.is_closed_preimage LowerSemicontinuous.isClosed_preimage

variable [TopologicalSpace γ] [OrderTopology γ]

theorem ContinuousWithinAt.lowerSemicontinuousWithinAt {f : α → γ} (h : ContinuousWithinAt f s x) :
    LowerSemicontinuousWithinAt f s x := fun _y hy => h (Ioi_mem_nhds hy)
#align continuous_within_at.lower_semicontinuous_within_at ContinuousWithinAt.lowerSemicontinuousWithinAt

theorem ContinuousAt.lowerSemicontinuousAt {f : α → γ} (h : ContinuousAt f x) :
    LowerSemicontinuousAt f x := fun _y hy => h (Ioi_mem_nhds hy)
#align continuous_at.lower_semicontinuous_at ContinuousAt.lowerSemicontinuousAt

theorem ContinuousOn.lowerSemicontinuousOn {f : α → γ} (h : ContinuousOn f s) :
    LowerSemicontinuousOn f s := fun x hx => (h x hx).lowerSemicontinuousWithinAt
#align continuous_on.lower_semicontinuous_on ContinuousOn.lowerSemicontinuousOn

theorem Continuous.lowerSemicontinuous {f : α → γ} (h : Continuous f) : LowerSemicontinuous f :=
  fun _x => h.continuousAt.lowerSemicontinuousAt
#align continuous.lower_semicontinuous Continuous.lowerSemicontinuous

end

/-! ### Composition -/

section

variable {γ : Type _} [LinearOrder γ] [TopologicalSpace γ] [OrderTopology γ]

variable {δ : Type _} [LinearOrder δ] [TopologicalSpace δ] [OrderTopology δ]

theorem ContinuousAt.comp_lowerSemicontinuousWithinAt {g : γ → δ} {f : α → γ}
    (hg : ContinuousAt g (f x)) (hf : LowerSemicontinuousWithinAt f s x) (gmon : Monotone g) :
    LowerSemicontinuousWithinAt (g ∘ f) s x := by
  intro y hy
  by_cases h : ∃ l, l < f x
  · obtain ⟨z, zlt, hz⟩ : ∃ z < f x, Ioc z (f x) ⊆ g ⁻¹' Ioi y :=
      exists_Ioc_subset_of_mem_nhds (hg (Ioi_mem_nhds hy)) h
    filter_upwards [hf z zlt]with a ha
    calc
      y < g (min (f x) (f a)) := hz (by simp [zlt, ha, le_refl])
      _ ≤ g (f a) := gmon (min_le_right _ _)

  · simp only [not_exists, not_lt] at h
    exact Filter.eventually_of_forall fun a => hy.trans_le (gmon (h (f a)))
#align continuous_at.comp_lower_semicontinuous_within_at ContinuousAt.comp_lowerSemicontinuousWithinAt

theorem ContinuousAt.comp_lowerSemicontinuousAt {g : γ → δ} {f : α → γ} (hg : ContinuousAt g (f x))
    (hf : LowerSemicontinuousAt f x) (gmon : Monotone g) : LowerSemicontinuousAt (g ∘ f) x := by
  simp only [← lowerSemicontinuousWithinAt_univ_iff] at hf⊢
  exact hg.comp_lowerSemicontinuousWithinAt hf gmon
#align continuous_at.comp_lower_semicontinuous_at ContinuousAt.comp_lowerSemicontinuousAt

theorem Continuous.comp_lowerSemicontinuousOn {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : LowerSemicontinuousOn f s) (gmon : Monotone g) : LowerSemicontinuousOn (g ∘ f) s :=
  fun x hx => hg.continuousAt.comp_lowerSemicontinuousWithinAt (hf x hx) gmon
#align continuous.comp_lower_semicontinuous_on Continuous.comp_lowerSemicontinuousOn

theorem Continuous.comp_lowerSemicontinuous {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : LowerSemicontinuous f) (gmon : Monotone g) : LowerSemicontinuous (g ∘ f) := fun x =>
  hg.continuousAt.comp_lowerSemicontinuousAt (hf x) gmon
#align continuous.comp_lower_semicontinuous Continuous.comp_lowerSemicontinuous

theorem ContinuousAt.comp_lowerSemicontinuousWithinAt_antitone {g : γ → δ} {f : α → γ}
    (hg : ContinuousAt g (f x)) (hf : LowerSemicontinuousWithinAt f s x) (gmon : Antitone g) :
    UpperSemicontinuousWithinAt (g ∘ f) s x :=
  @ContinuousAt.comp_lowerSemicontinuousWithinAt α _ x s γ _ _ _ δᵒᵈ _ _ _ g f hg hf gmon
#align continuous_at.comp_lower_semicontinuous_within_at_antitone ContinuousAt.comp_lowerSemicontinuousWithinAt_antitone

theorem ContinuousAt.comp_lowerSemicontinuousAt_antitone {g : γ → δ} {f : α → γ}
    (hg : ContinuousAt g (f x)) (hf : LowerSemicontinuousAt f x) (gmon : Antitone g) :
    UpperSemicontinuousAt (g ∘ f) x :=
  @ContinuousAt.comp_lowerSemicontinuousAt α _ x γ _ _ _ δᵒᵈ _ _ _ g f hg hf gmon
#align continuous_at.comp_lower_semicontinuous_at_antitone ContinuousAt.comp_lowerSemicontinuousAt_antitone

theorem Continuous.comp_lowerSemicontinuousOn_antitone {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : LowerSemicontinuousOn f s) (gmon : Antitone g) : UpperSemicontinuousOn (g ∘ f) s :=
  fun x hx => hg.continuousAt.comp_lowerSemicontinuousWithinAt_antitone (hf x hx) gmon
#align continuous.comp_lower_semicontinuous_on_antitone Continuous.comp_lowerSemicontinuousOn_antitone

theorem Continuous.comp_lowerSemicontinuous_antitone {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : LowerSemicontinuous f) (gmon : Antitone g) : UpperSemicontinuous (g ∘ f) := fun x =>
  hg.continuousAt.comp_lowerSemicontinuousAt_antitone (hf x) gmon
#align continuous.comp_lower_semicontinuous_antitone Continuous.comp_lowerSemicontinuous_antitone

end

/-! #### Addition -/

section

variable {ι : Type _} {γ : Type _} [LinearOrderedAddCommMonoid γ] [TopologicalSpace γ]
  [OrderTopology γ]

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem LowerSemicontinuousWithinAt.add' {f g : α → γ} (hf : LowerSemicontinuousWithinAt f s x)
    (hg : LowerSemicontinuousWithinAt g s x)
    (hcont : ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    LowerSemicontinuousWithinAt (fun z => f z + g z) s x := by
  intro y hy
  obtain ⟨u, v, u_open, xu, v_open, xv, h⟩ :
    ∃ u v : Set γ,
      IsOpen u ∧ f x ∈ u ∧ IsOpen v ∧ g x ∈ v ∧ u ×ˢ v ⊆ { p : γ × γ | y < p.fst + p.snd } :=
    mem_nhds_prod_iff'.1 (hcont (isOpen_Ioi.mem_nhds hy))
  by_cases hx₁ : ∃ l, l < f x
  · obtain ⟨z₁, z₁lt, h₁⟩ : ∃ z₁ < f x, Ioc z₁ (f x) ⊆ u :=
      exists_Ioc_subset_of_mem_nhds (u_open.mem_nhds xu) hx₁
    by_cases hx₂ : ∃ l, l < g x
    · obtain ⟨z₂, z₂lt, h₂⟩ : ∃ z₂ < g x, Ioc z₂ (g x) ⊆ v :=
        exists_Ioc_subset_of_mem_nhds (v_open.mem_nhds xv) hx₂
      filter_upwards [hf z₁ z₁lt, hg z₂ z₂lt]with z h₁z h₂z
      have A1 : min (f z) (f x) ∈ u := by
        by_cases H : f z ≤ f x
        · simp [H]
          exact h₁ ⟨h₁z, H⟩
        · simp [le_of_not_le H]
          exact h₁ ⟨z₁lt, le_rfl⟩
      have A2 : min (g z) (g x) ∈ v := by
        by_cases H : g z ≤ g x
        · simp [H]
          exact h₂ ⟨h₂z, H⟩
        · simp [le_of_not_le H]
          exact h₂ ⟨z₂lt, le_rfl⟩
      have : (min (f z) (f x), min (g z) (g x)) ∈ u ×ˢ v := ⟨A1, A2⟩
      calc
        y < min (f z) (f x) + min (g z) (g x) := h this
        _ ≤ f z + g z := add_le_add (min_le_left _ _) (min_le_left _ _)

    · simp only [not_exists, not_lt] at hx₂
      filter_upwards [hf z₁ z₁lt]with z h₁z
      have A1 : min (f z) (f x) ∈ u := by
        by_cases H : f z ≤ f x
        · simp [H]
          exact h₁ ⟨h₁z, H⟩
        · simp [le_of_not_le H]
          exact h₁ ⟨z₁lt, le_rfl⟩
      have : (min (f z) (f x), g x) ∈ u ×ˢ v := ⟨A1, xv⟩
      calc
        y < min (f z) (f x) + g x := h this
        _ ≤ f z + g z := add_le_add (min_le_left _ _) (hx₂ (g z))

  · simp only [not_exists, not_lt] at hx₁
    by_cases hx₂ : ∃ l, l < g x
    · obtain ⟨z₂, z₂lt, h₂⟩ : ∃ z₂ < g x, Ioc z₂ (g x) ⊆ v :=
        exists_Ioc_subset_of_mem_nhds (v_open.mem_nhds xv) hx₂
      filter_upwards [hg z₂ z₂lt]with z h₂z
      have A2 : min (g z) (g x) ∈ v := by
        by_cases H : g z ≤ g x
        · simp [H]
          exact h₂ ⟨h₂z, H⟩
        · simp [le_of_not_le H]
          exact h₂ ⟨z₂lt, le_rfl⟩
      have : (f x, min (g z) (g x)) ∈ u ×ˢ v := ⟨xu, A2⟩
      calc
        y < f x + min (g z) (g x) := h this
        _ ≤ f z + g z := add_le_add (hx₁ (f z)) (min_le_left _ _)

    · simp only [not_exists, not_lt] at hx₁ hx₂
      apply Filter.eventually_of_forall
      intro z
      have : (f x, g x) ∈ u ×ˢ v := ⟨xu, xv⟩
      calc
        y < f x + g x := h this
        _ ≤ f z + g z := add_le_add (hx₁ (f z)) (hx₂ (g z))

#align lower_semicontinuous_within_at.add' LowerSemicontinuousWithinAt.add'

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem LowerSemicontinuousAt.add' {f g : α → γ} (hf : LowerSemicontinuousAt f x)
    (hg : LowerSemicontinuousAt g x)
    (hcont : ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    LowerSemicontinuousAt (fun z => f z + g z) x := by
  simp_rw [← lowerSemicontinuousWithinAt_univ_iff] at *
  exact hf.add' hg hcont
#align lower_semicontinuous_at.add' LowerSemicontinuousAt.add'

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem LowerSemicontinuousOn.add' {f g : α → γ} (hf : LowerSemicontinuousOn f s)
    (hg : LowerSemicontinuousOn g s)
    (hcont : ∀ x ∈ s, ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    LowerSemicontinuousOn (fun z => f z + g z) s := fun x hx =>
  (hf x hx).add' (hg x hx) (hcont x hx)
#align lower_semicontinuous_on.add' LowerSemicontinuousOn.add'

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem LowerSemicontinuous.add' {f g : α → γ} (hf : LowerSemicontinuous f)
    (hg : LowerSemicontinuous g)
    (hcont : ∀ x, ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    LowerSemicontinuous fun z => f z + g z := fun x => (hf x).add' (hg x) (hcont x)
#align lower_semicontinuous.add' LowerSemicontinuous.add'

variable [ContinuousAdd γ]

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem LowerSemicontinuousWithinAt.add {f g : α → γ} (hf : LowerSemicontinuousWithinAt f s x)
    (hg : LowerSemicontinuousWithinAt g s x) :
    LowerSemicontinuousWithinAt (fun z => f z + g z) s x :=
  hf.add' hg continuous_add.continuousAt
#align lower_semicontinuous_within_at.add LowerSemicontinuousWithinAt.add

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem LowerSemicontinuousAt.add {f g : α → γ} (hf : LowerSemicontinuousAt f x)
    (hg : LowerSemicontinuousAt g x) : LowerSemicontinuousAt (fun z => f z + g z) x :=
  hf.add' hg continuous_add.continuousAt
#align lower_semicontinuous_at.add LowerSemicontinuousAt.add

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem LowerSemicontinuousOn.add {f g : α → γ} (hf : LowerSemicontinuousOn f s)
    (hg : LowerSemicontinuousOn g s) : LowerSemicontinuousOn (fun z => f z + g z) s :=
  hf.add' hg fun _x _hx => continuous_add.continuousAt
#align lower_semicontinuous_on.add LowerSemicontinuousOn.add

/-- The sum of two lower semicontinuous functions is lower semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem LowerSemicontinuous.add {f g : α → γ} (hf : LowerSemicontinuous f)
    (hg : LowerSemicontinuous g) : LowerSemicontinuous fun z => f z + g z :=
  hf.add' hg fun _x => continuous_add.continuousAt
#align lower_semicontinuous.add LowerSemicontinuous.add

theorem lowerSemicontinuousWithinAt_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, LowerSemicontinuousWithinAt (f i) s x) :
    LowerSemicontinuousWithinAt (fun z => ∑ i in a, f i z) s x := by
  classical
    induction' a using Finset.induction_on with i a ia IH
    · exact lowerSemicontinuousWithinAt_const
    · simp only [ia, Finset.sum_insert, not_false_iff]
      exact
        LowerSemicontinuousWithinAt.add (ha _ (Finset.mem_insert_self i a))
          (IH fun j ja => ha j (Finset.mem_insert_of_mem ja))
#align lower_semicontinuous_within_at_sum lowerSemicontinuousWithinAt_sum

theorem lowerSemicontinuousAt_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, LowerSemicontinuousAt (f i) x) :
    LowerSemicontinuousAt (fun z => ∑ i in a, f i z) x := by
  simp_rw [← lowerSemicontinuousWithinAt_univ_iff] at *
  exact lowerSemicontinuousWithinAt_sum ha
#align lower_semicontinuous_at_sum lowerSemicontinuousAt_sum

theorem lowerSemicontinuousOn_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, LowerSemicontinuousOn (f i) s) :
    LowerSemicontinuousOn (fun z => ∑ i in a, f i z) s := fun x hx =>
  lowerSemicontinuousWithinAt_sum fun i hi => ha i hi x hx
#align lower_semicontinuous_on_sum lowerSemicontinuousOn_sum

theorem lowerSemicontinuous_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, LowerSemicontinuous (f i)) : LowerSemicontinuous fun z => ∑ i in a, f i z :=
  fun x => lowerSemicontinuousAt_sum fun i hi => ha i hi x
#align lower_semicontinuous_sum lowerSemicontinuous_sum

end

/-! #### Supremum -/

section

variable {ι : Sort _} {δ δ' : Type _} [CompleteLinearOrder δ] [ConditionallyCompleteLinearOrder δ']

theorem lowerSemicontinuousWithinAt_csupr {f : ι → α → δ'}
    (bdd : ∀ᶠ y in 𝓝[s] x, BddAbove (range fun i => f i y))
    (h : ∀ i, LowerSemicontinuousWithinAt (f i) s x) :
    LowerSemicontinuousWithinAt (fun x' => ⨆ i, f i x') s x := by
  cases isEmpty_or_nonempty ι
  · simpa only [supᵢ_of_empty'] using lowerSemicontinuousWithinAt_const
  · intro y hy
    rcases exists_lt_of_lt_csupᵢ hy with ⟨i, hi⟩
    filter_upwards [h i y hi, bdd]with y hy hy' using hy.trans_le (le_csupᵢ hy' i)
#align lower_semicontinuous_within_at_csupr lowerSemicontinuousWithinAt_csupr

theorem lowerSemicontinuousWithinAt_supᵢ {f : ι → α → δ}
    (h : ∀ i, LowerSemicontinuousWithinAt (f i) s x) :
    LowerSemicontinuousWithinAt (fun x' => ⨆ i, f i x') s x :=
  lowerSemicontinuousWithinAt_csupr (by simp) h
#align lower_semicontinuous_within_at_supr lowerSemicontinuousWithinAt_supᵢ

theorem lowerSemicontinuousWithinAt_bsupr {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, LowerSemicontinuousWithinAt (f i hi) s x) :
    LowerSemicontinuousWithinAt (fun x' => ⨆ (i) (hi), f i hi x') s x :=
  lowerSemicontinuousWithinAt_supᵢ fun i => lowerSemicontinuousWithinAt_supᵢ fun hi => h i hi
#align lower_semicontinuous_within_at_bsupr lowerSemicontinuousWithinAt_bsupr

theorem lowerSemicontinuousAt_csupr {f : ι → α → δ'}
    (bdd : ∀ᶠ y in 𝓝 x, BddAbove (range fun i => f i y)) (h : ∀ i, LowerSemicontinuousAt (f i) x) :
    LowerSemicontinuousAt (fun x' => ⨆ i, f i x') x := by
  simp_rw [← lowerSemicontinuousWithinAt_univ_iff] at *
  rw [← nhdsWithin_univ] at bdd
  exact lowerSemicontinuousWithinAt_csupr bdd h
#align lower_semicontinuous_at_csupr lowerSemicontinuousAt_csupr

theorem lowerSemicontinuousAt_supᵢ {f : ι → α → δ} (h : ∀ i, LowerSemicontinuousAt (f i) x) :
    LowerSemicontinuousAt (fun x' => ⨆ i, f i x') x :=
  lowerSemicontinuousAt_csupr (by simp) h
#align lower_semicontinuous_at_supr lowerSemicontinuousAt_supᵢ

theorem lowerSemicontinuousAt_bsupr {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, LowerSemicontinuousAt (f i hi) x) :
    LowerSemicontinuousAt (fun x' => ⨆ (i) (hi), f i hi x') x :=
  lowerSemicontinuousAt_supᵢ fun i => lowerSemicontinuousAt_supᵢ fun hi => h i hi
#align lower_semicontinuous_at_bsupr lowerSemicontinuousAt_bsupr

theorem lowerSemicontinuousOn_csupr {f : ι → α → δ'}
    (bdd : ∀ x ∈ s, BddAbove (range fun i => f i x)) (h : ∀ i, LowerSemicontinuousOn (f i) s) :
    LowerSemicontinuousOn (fun x' => ⨆ i, f i x') s := fun x hx =>
  lowerSemicontinuousWithinAt_csupr (eventually_nhdsWithin_of_forall bdd) fun i => h i x hx
#align lower_semicontinuous_on_csupr lowerSemicontinuousOn_csupr

theorem lowerSemicontinuousOn_supᵢ {f : ι → α → δ} (h : ∀ i, LowerSemicontinuousOn (f i) s) :
    LowerSemicontinuousOn (fun x' => ⨆ i, f i x') s :=
  lowerSemicontinuousOn_csupr (by simp) h
#align lower_semicontinuous_on_supr lowerSemicontinuousOn_supᵢ

theorem lowerSemicontinuousOn_bsupr {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, LowerSemicontinuousOn (f i hi) s) :
    LowerSemicontinuousOn (fun x' => ⨆ (i) (hi), f i hi x') s :=
  lowerSemicontinuousOn_supᵢ fun i => lowerSemicontinuousOn_supᵢ fun hi => h i hi
#align lower_semicontinuous_on_bsupr lowerSemicontinuousOn_bsupr

theorem lowerSemicontinuous_csupr {f : ι → α → δ'} (bdd : ∀ x, BddAbove (range fun i => f i x))
    (h : ∀ i, LowerSemicontinuous (f i)) : LowerSemicontinuous fun x' => ⨆ i, f i x' := fun x =>
  lowerSemicontinuousAt_csupr (eventually_of_forall bdd) fun i => h i x
#align lower_semicontinuous_csupr lowerSemicontinuous_csupr

theorem lowerSemicontinuous_supᵢ {f : ι → α → δ} (h : ∀ i, LowerSemicontinuous (f i)) :
    LowerSemicontinuous fun x' => ⨆ i, f i x' :=
  lowerSemicontinuous_csupr (by simp) h
#align lower_semicontinuous_supr lowerSemicontinuous_supᵢ

theorem lowerSemicontinuous_bsupr {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, LowerSemicontinuous (f i hi)) :
    LowerSemicontinuous fun x' => ⨆ (i) (hi), f i hi x' :=
  lowerSemicontinuous_supᵢ fun i => lowerSemicontinuous_supᵢ fun hi => h i hi
#align lower_semicontinuous_bsupr lowerSemicontinuous_bsupr

end

/-! #### Infinite sums -/

section

variable {ι : Type _}

theorem lowerSemicontinuousWithinAt_tsum {f : ι → α → ℝ≥0∞}
    (h : ∀ i, LowerSemicontinuousWithinAt (f i) s x) :
    LowerSemicontinuousWithinAt (fun x' => ∑' i, f i x') s x := by
  simp_rw [ENNReal.tsum_eq_supᵢ_sum]
  refine lowerSemicontinuousWithinAt_supᵢ fun b => ?_
  exact lowerSemicontinuousWithinAt_sum fun i _hi => h i
#align lower_semicontinuous_within_at_tsum lowerSemicontinuousWithinAt_tsum

theorem lowerSemicontinuousAt_tsum {f : ι → α → ℝ≥0∞} (h : ∀ i, LowerSemicontinuousAt (f i) x) :
    LowerSemicontinuousAt (fun x' => ∑' i, f i x') x := by
  simp_rw [← lowerSemicontinuousWithinAt_univ_iff] at *
  exact lowerSemicontinuousWithinAt_tsum h
#align lower_semicontinuous_at_tsum lowerSemicontinuousAt_tsum

theorem lowerSemicontinuousOn_tsum {f : ι → α → ℝ≥0∞} (h : ∀ i, LowerSemicontinuousOn (f i) s) :
    LowerSemicontinuousOn (fun x' => ∑' i, f i x') s := fun x hx =>
  lowerSemicontinuousWithinAt_tsum fun i => h i x hx
#align lower_semicontinuous_on_tsum lowerSemicontinuousOn_tsum

theorem lowerSemicontinuous_tsum {f : ι → α → ℝ≥0∞} (h : ∀ i, LowerSemicontinuous (f i)) :
    LowerSemicontinuous fun x' => ∑' i, f i x' := fun x => lowerSemicontinuousAt_tsum fun i => h i x
#align lower_semicontinuous_tsum lowerSemicontinuous_tsum

end

/-!
### Upper semicontinuous functions
-/

/-! #### Basic dot notation interface for upper semicontinuity -/

theorem UpperSemicontinuousWithinAt.mono (h : UpperSemicontinuousWithinAt f s x) (hst : t ⊆ s) :
    UpperSemicontinuousWithinAt f t x := fun y hy =>
  Filter.Eventually.filter_mono (nhdsWithin_mono _ hst) (h y hy)
#align upper_semicontinuous_within_at.mono UpperSemicontinuousWithinAt.mono

theorem upperSemicontinuousWithinAt_univ_iff :
    UpperSemicontinuousWithinAt f univ x ↔ UpperSemicontinuousAt f x := by
  simp [UpperSemicontinuousWithinAt, UpperSemicontinuousAt, nhdsWithin_univ]
#align upper_semicontinuous_within_at_univ_iff upperSemicontinuousWithinAt_univ_iff

theorem UpperSemicontinuousAt.upperSemicontinuousWithinAt (s : Set α)
    (h : UpperSemicontinuousAt f x) : UpperSemicontinuousWithinAt f s x := fun y hy =>
  Filter.Eventually.filter_mono nhdsWithin_le_nhds (h y hy)
#align upper_semicontinuous_at.upper_semicontinuous_within_at UpperSemicontinuousAt.upperSemicontinuousWithinAt

theorem UpperSemicontinuousOn.upperSemicontinuousWithinAt (h : UpperSemicontinuousOn f s)
    (hx : x ∈ s) : UpperSemicontinuousWithinAt f s x :=
  h x hx
#align upper_semicontinuous_on.upper_semicontinuous_within_at UpperSemicontinuousOn.upperSemicontinuousWithinAt

theorem UpperSemicontinuousOn.mono (h : UpperSemicontinuousOn f s) (hst : t ⊆ s) :
    UpperSemicontinuousOn f t := fun x hx => (h x (hst hx)).mono hst
#align upper_semicontinuous_on.mono UpperSemicontinuousOn.mono

theorem upperSemicontinuousOn_univ_iff : UpperSemicontinuousOn f univ ↔ UpperSemicontinuous f := by
  simp [UpperSemicontinuousOn, UpperSemicontinuous, upperSemicontinuousWithinAt_univ_iff]
#align upper_semicontinuous_on_univ_iff upperSemicontinuousOn_univ_iff

theorem UpperSemicontinuous.upperSemicontinuousAt (h : UpperSemicontinuous f) (x : α) :
    UpperSemicontinuousAt f x :=
  h x
#align upper_semicontinuous.upper_semicontinuous_at UpperSemicontinuous.upperSemicontinuousAt

theorem UpperSemicontinuous.upperSemicontinuousWithinAt (h : UpperSemicontinuous f) (s : Set α)
    (x : α) : UpperSemicontinuousWithinAt f s x :=
  (h x).upperSemicontinuousWithinAt s
#align upper_semicontinuous.upper_semicontinuous_within_at UpperSemicontinuous.upperSemicontinuousWithinAt

theorem UpperSemicontinuous.upperSemicontinuousOn (h : UpperSemicontinuous f) (s : Set α) :
    UpperSemicontinuousOn f s := fun x _hx => h.upperSemicontinuousWithinAt s x
#align upper_semicontinuous.upper_semicontinuous_on UpperSemicontinuous.upperSemicontinuousOn

/-! #### Constants -/

theorem upperSemicontinuousWithinAt_const : UpperSemicontinuousWithinAt (fun _x => z) s x :=
  fun _y hy => Filter.eventually_of_forall fun _x => hy
#align upper_semicontinuous_within_at_const upperSemicontinuousWithinAt_const

theorem upperSemicontinuousAt_const : UpperSemicontinuousAt (fun _x => z) x := fun _y hy =>
  Filter.eventually_of_forall fun _x => hy
#align upper_semicontinuous_at_const upperSemicontinuousAt_const

theorem upperSemicontinuousOn_const : UpperSemicontinuousOn (fun _x => z) s := fun _x _hx =>
  upperSemicontinuousWithinAt_const
#align upper_semicontinuous_on_const upperSemicontinuousOn_const

theorem upperSemicontinuous_const : UpperSemicontinuous fun _x : α => z := fun _x =>
  upperSemicontinuousAt_const
#align upper_semicontinuous_const upperSemicontinuous_const

/-! #### Indicators -/

section

variable [Zero β]

theorem IsOpen.upperSemicontinuous_indicator (hs : IsOpen s) (hy : y ≤ 0) :
    UpperSemicontinuous (indicator s fun _x => y) :=
  @IsOpen.lowerSemicontinuous_indicator α _ βᵒᵈ _ s y _ hs hy
#align is_open.upper_semicontinuous_indicator IsOpen.upperSemicontinuous_indicator

theorem IsOpen.upperSemicontinuousOn_indicator (hs : IsOpen s) (hy : y ≤ 0) :
    UpperSemicontinuousOn (indicator s fun _x => y) t :=
  (hs.upperSemicontinuous_indicator hy).upperSemicontinuousOn t
#align is_open.upper_semicontinuous_on_indicator IsOpen.upperSemicontinuousOn_indicator

theorem IsOpen.upperSemicontinuousAt_indicator (hs : IsOpen s) (hy : y ≤ 0) :
    UpperSemicontinuousAt (indicator s fun _x => y) x :=
  (hs.upperSemicontinuous_indicator hy).upperSemicontinuousAt x
#align is_open.upper_semicontinuous_at_indicator IsOpen.upperSemicontinuousAt_indicator

theorem IsOpen.upperSemicontinuousWithinAt_indicator (hs : IsOpen s) (hy : y ≤ 0) :
    UpperSemicontinuousWithinAt (indicator s fun _x => y) t x :=
  (hs.upperSemicontinuous_indicator hy).upperSemicontinuousWithinAt t x
#align is_open.upper_semicontinuous_within_at_indicator IsOpen.upperSemicontinuousWithinAt_indicator

theorem IsClosed.upperSemicontinuous_indicator (hs : IsClosed s) (hy : 0 ≤ y) :
    UpperSemicontinuous (indicator s fun _x => y) :=
  @IsClosed.lowerSemicontinuous_indicator α _ βᵒᵈ _ s y _ hs hy
#align is_closed.upper_semicontinuous_indicator IsClosed.upperSemicontinuous_indicator

theorem IsClosed.upperSemicontinuousOn_indicator (hs : IsClosed s) (hy : 0 ≤ y) :
    UpperSemicontinuousOn (indicator s fun _x => y) t :=
  (hs.upperSemicontinuous_indicator hy).upperSemicontinuousOn t
#align is_closed.upper_semicontinuous_on_indicator IsClosed.upperSemicontinuousOn_indicator

theorem IsClosed.upperSemicontinuousAt_indicator (hs : IsClosed s) (hy : 0 ≤ y) :
    UpperSemicontinuousAt (indicator s fun _x => y) x :=
  (hs.upperSemicontinuous_indicator hy).upperSemicontinuousAt x
#align is_closed.upper_semicontinuous_at_indicator IsClosed.upperSemicontinuousAt_indicator

theorem IsClosed.upperSemicontinuousWithinAt_indicator (hs : IsClosed s) (hy : 0 ≤ y) :
    UpperSemicontinuousWithinAt (indicator s fun _x => y) t x :=
  (hs.upperSemicontinuous_indicator hy).upperSemicontinuousWithinAt t x
#align is_closed.upper_semicontinuous_within_at_indicator IsClosed.upperSemicontinuousWithinAt_indicator

end

/-! #### Relationship with continuity -/

theorem upperSemicontinuous_iff_isOpen_preimage :
    UpperSemicontinuous f ↔ ∀ y, IsOpen (f ⁻¹' Iio y) :=
  ⟨fun H y => isOpen_iff_mem_nhds.2 fun x hx => H x y hx, fun H _x y y_lt =>
    IsOpen.mem_nhds (H y) y_lt⟩
#align upper_semicontinuous_iff_is_open_preimage upperSemicontinuous_iff_isOpen_preimage

theorem UpperSemicontinuous.isOpen_preimage (hf : UpperSemicontinuous f) (y : β) :
    IsOpen (f ⁻¹' Iio y) :=
  upperSemicontinuous_iff_isOpen_preimage.1 hf y
#align upper_semicontinuous.is_open_preimage UpperSemicontinuous.isOpen_preimage

section

variable {γ : Type _} [LinearOrder γ]

theorem upperSemicontinuous_iff_isClosed_preimage {f : α → γ} :
    UpperSemicontinuous f ↔ ∀ y, IsClosed (f ⁻¹' Ici y) := by
  rw [upperSemicontinuous_iff_isOpen_preimage]
  simp only [← isOpen_compl_iff, ← preimage_compl, compl_Ici]
#align upper_semicontinuous_iff_is_closed_preimage upperSemicontinuous_iff_isClosed_preimage

theorem UpperSemicontinuous.isClosed_preimage {f : α → γ} (hf : UpperSemicontinuous f) (y : γ) :
    IsClosed (f ⁻¹' Ici y) :=
  upperSemicontinuous_iff_isClosed_preimage.1 hf y
#align upper_semicontinuous.is_closed_preimage UpperSemicontinuous.isClosed_preimage

variable [TopologicalSpace γ] [OrderTopology γ]

theorem ContinuousWithinAt.upperSemicontinuousWithinAt {f : α → γ} (h : ContinuousWithinAt f s x) :
    UpperSemicontinuousWithinAt f s x := fun _y hy => h (Iio_mem_nhds hy)
#align continuous_within_at.upper_semicontinuous_within_at ContinuousWithinAt.upperSemicontinuousWithinAt

theorem ContinuousAt.upperSemicontinuousAt {f : α → γ} (h : ContinuousAt f x) :
    UpperSemicontinuousAt f x := fun _y hy => h (Iio_mem_nhds hy)
#align continuous_at.upper_semicontinuous_at ContinuousAt.upperSemicontinuousAt

theorem ContinuousOn.upperSemicontinuousOn {f : α → γ} (h : ContinuousOn f s) :
    UpperSemicontinuousOn f s := fun x hx => (h x hx).upperSemicontinuousWithinAt
#align continuous_on.upper_semicontinuous_on ContinuousOn.upperSemicontinuousOn

theorem Continuous.upperSemicontinuous {f : α → γ} (h : Continuous f) : UpperSemicontinuous f :=
  fun _x => h.continuousAt.upperSemicontinuousAt
#align continuous.upper_semicontinuous Continuous.upperSemicontinuous

end

/-! ### Composition -/

section

variable {γ : Type _} [LinearOrder γ] [TopologicalSpace γ] [OrderTopology γ]

variable {δ : Type _} [LinearOrder δ] [TopologicalSpace δ] [OrderTopology δ]

theorem ContinuousAt.comp_upperSemicontinuousWithinAt {g : γ → δ} {f : α → γ}
    (hg : ContinuousAt g (f x)) (hf : UpperSemicontinuousWithinAt f s x) (gmon : Monotone g) :
    UpperSemicontinuousWithinAt (g ∘ f) s x :=
  @ContinuousAt.comp_lowerSemicontinuousWithinAt α _ x s γᵒᵈ _ _ _ δᵒᵈ _ _ _ g f hg hf gmon.dual
#align continuous_at.comp_upper_semicontinuous_within_at ContinuousAt.comp_upperSemicontinuousWithinAt

theorem ContinuousAt.comp_upperSemicontinuousAt {g : γ → δ} {f : α → γ} (hg : ContinuousAt g (f x))
    (hf : UpperSemicontinuousAt f x) (gmon : Monotone g) : UpperSemicontinuousAt (g ∘ f) x :=
  @ContinuousAt.comp_lowerSemicontinuousAt α _ x γᵒᵈ _ _ _ δᵒᵈ _ _ _ g f hg hf gmon.dual
#align continuous_at.comp_upper_semicontinuous_at ContinuousAt.comp_upperSemicontinuousAt

theorem Continuous.comp_upperSemicontinuousOn {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : UpperSemicontinuousOn f s) (gmon : Monotone g) : UpperSemicontinuousOn (g ∘ f) s :=
  fun x hx => hg.continuousAt.comp_upperSemicontinuousWithinAt (hf x hx) gmon
#align continuous.comp_upper_semicontinuous_on Continuous.comp_upperSemicontinuousOn

theorem Continuous.comp_upperSemicontinuous {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : UpperSemicontinuous f) (gmon : Monotone g) : UpperSemicontinuous (g ∘ f) := fun x =>
  hg.continuousAt.comp_upperSemicontinuousAt (hf x) gmon
#align continuous.comp_upper_semicontinuous Continuous.comp_upperSemicontinuous

theorem ContinuousAt.comp_upperSemicontinuousWithinAt_antitone {g : γ → δ} {f : α → γ}
    (hg : ContinuousAt g (f x)) (hf : UpperSemicontinuousWithinAt f s x) (gmon : Antitone g) :
    LowerSemicontinuousWithinAt (g ∘ f) s x :=
  @ContinuousAt.comp_upperSemicontinuousWithinAt α _ x s γ _ _ _ δᵒᵈ _ _ _ g f hg hf gmon
#align continuous_at.comp_upper_semicontinuous_within_at_antitone ContinuousAt.comp_upperSemicontinuousWithinAt_antitone

theorem ContinuousAt.comp_upperSemicontinuousAt_antitone {g : γ → δ} {f : α → γ}
    (hg : ContinuousAt g (f x)) (hf : UpperSemicontinuousAt f x) (gmon : Antitone g) :
    LowerSemicontinuousAt (g ∘ f) x :=
  @ContinuousAt.comp_upperSemicontinuousAt α _ x γ _ _ _ δᵒᵈ _ _ _ g f hg hf gmon
#align continuous_at.comp_upper_semicontinuous_at_antitone ContinuousAt.comp_upperSemicontinuousAt_antitone

theorem Continuous.comp_upperSemicontinuousOn_antitone {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : UpperSemicontinuousOn f s) (gmon : Antitone g) : LowerSemicontinuousOn (g ∘ f) s :=
  fun x hx => hg.continuousAt.comp_upperSemicontinuousWithinAt_antitone (hf x hx) gmon
#align continuous.comp_upper_semicontinuous_on_antitone Continuous.comp_upperSemicontinuousOn_antitone

theorem Continuous.comp_upperSemicontinuous_antitone {g : γ → δ} {f : α → γ} (hg : Continuous g)
    (hf : UpperSemicontinuous f) (gmon : Antitone g) : LowerSemicontinuous (g ∘ f) := fun x =>
  hg.continuousAt.comp_upperSemicontinuousAt_antitone (hf x) gmon
#align continuous.comp_upper_semicontinuous_antitone Continuous.comp_upperSemicontinuous_antitone

end

/-! #### Addition -/

section

variable {ι : Type _} {γ : Type _} [LinearOrderedAddCommMonoid γ] [TopologicalSpace γ]
  [OrderTopology γ]

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem UpperSemicontinuousWithinAt.add' {f g : α → γ} (hf : UpperSemicontinuousWithinAt f s x)
    (hg : UpperSemicontinuousWithinAt g s x)
    (hcont : ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    UpperSemicontinuousWithinAt (fun z => f z + g z) s x :=
  @LowerSemicontinuousWithinAt.add' α _ x s γᵒᵈ _ _ _ _ _ hf hg hcont
#align upper_semicontinuous_within_at.add' UpperSemicontinuousWithinAt.add'

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem UpperSemicontinuousAt.add' {f g : α → γ} (hf : UpperSemicontinuousAt f x)
    (hg : UpperSemicontinuousAt g x)
    (hcont : ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    UpperSemicontinuousAt (fun z => f z + g z) x := by
  simp_rw [← upperSemicontinuousWithinAt_univ_iff] at *
  exact hf.add' hg hcont
#align upper_semicontinuous_at.add' UpperSemicontinuousAt.add'

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem UpperSemicontinuousOn.add' {f g : α → γ} (hf : UpperSemicontinuousOn f s)
    (hg : UpperSemicontinuousOn g s)
    (hcont : ∀ x ∈ s, ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    UpperSemicontinuousOn (fun z => f z + g z) s := fun x hx =>
  (hf x hx).add' (hg x hx) (hcont x hx)
#align upper_semicontinuous_on.add' UpperSemicontinuousOn.add'

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with an
explicit continuity assumption on addition, for application to `EReal`. The unprimed version of
the lemma uses `[ContinuousAdd]`. -/
theorem UpperSemicontinuous.add' {f g : α → γ} (hf : UpperSemicontinuous f)
    (hg : UpperSemicontinuous g)
    (hcont : ∀ x, ContinuousAt (fun p : γ × γ => p.1 + p.2) (f x, g x)) :
    UpperSemicontinuous fun z => f z + g z := fun x => (hf x).add' (hg x) (hcont x)
#align upper_semicontinuous.add' UpperSemicontinuous.add'

variable [ContinuousAdd γ]

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem UpperSemicontinuousWithinAt.add {f g : α → γ} (hf : UpperSemicontinuousWithinAt f s x)
    (hg : UpperSemicontinuousWithinAt g s x) :
    UpperSemicontinuousWithinAt (fun z => f z + g z) s x :=
  hf.add' hg continuous_add.continuousAt
#align upper_semicontinuous_within_at.add UpperSemicontinuousWithinAt.add

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem UpperSemicontinuousAt.add {f g : α → γ} (hf : UpperSemicontinuousAt f x)
    (hg : UpperSemicontinuousAt g x) : UpperSemicontinuousAt (fun z => f z + g z) x :=
  hf.add' hg continuous_add.continuousAt
#align upper_semicontinuous_at.add UpperSemicontinuousAt.add

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem UpperSemicontinuousOn.add {f g : α → γ} (hf : UpperSemicontinuousOn f s)
    (hg : UpperSemicontinuousOn g s) : UpperSemicontinuousOn (fun z => f z + g z) s :=
  hf.add' hg fun _x _hx => continuous_add.continuousAt
#align upper_semicontinuous_on.add UpperSemicontinuousOn.add

/-- The sum of two upper semicontinuous functions is upper semicontinuous. Formulated with
`[ContinuousAdd]`. The primed version of the lemma uses an explicit continuity assumption on
addition, for application to `EReal`. -/
theorem UpperSemicontinuous.add {f g : α → γ} (hf : UpperSemicontinuous f)
    (hg : UpperSemicontinuous g) : UpperSemicontinuous fun z => f z + g z :=
  hf.add' hg fun _x => continuous_add.continuousAt
#align upper_semicontinuous.add UpperSemicontinuous.add

theorem upperSemicontinuousWithinAt_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, UpperSemicontinuousWithinAt (f i) s x) :
    UpperSemicontinuousWithinAt (fun z => ∑ i in a, f i z) s x :=
  @lowerSemicontinuousWithinAt_sum α _ x s ι γᵒᵈ _ _ _ _ f a ha
#align upper_semicontinuous_within_at_sum upperSemicontinuousWithinAt_sum

theorem upperSemicontinuousAt_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, UpperSemicontinuousAt (f i) x) :
    UpperSemicontinuousAt (fun z => ∑ i in a, f i z) x := by
  simp_rw [← upperSemicontinuousWithinAt_univ_iff] at *
  exact upperSemicontinuousWithinAt_sum ha
#align upper_semicontinuous_at_sum upperSemicontinuousAt_sum

theorem upperSemicontinuousOn_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, UpperSemicontinuousOn (f i) s) :
    UpperSemicontinuousOn (fun z => ∑ i in a, f i z) s := fun x hx =>
  upperSemicontinuousWithinAt_sum fun i hi => ha i hi x hx
#align upper_semicontinuous_on_sum upperSemicontinuousOn_sum

theorem upperSemicontinuous_sum {f : ι → α → γ} {a : Finset ι}
    (ha : ∀ i ∈ a, UpperSemicontinuous (f i)) : UpperSemicontinuous fun z => ∑ i in a, f i z :=
  fun x => upperSemicontinuousAt_sum fun i hi => ha i hi x
#align upper_semicontinuous_sum upperSemicontinuous_sum

end

/-! #### Infimum -/

section

variable {ι : Sort _} {δ δ' : Type _} [CompleteLinearOrder δ] [ConditionallyCompleteLinearOrder δ']

theorem upperSemicontinuousWithinAt_cinfi {f : ι → α → δ'}
    (bdd : ∀ᶠ y in 𝓝[s] x, BddBelow (range fun i => f i y))
    (h : ∀ i, UpperSemicontinuousWithinAt (f i) s x) :
    UpperSemicontinuousWithinAt (fun x' => ⨅ i, f i x') s x :=
  @lowerSemicontinuousWithinAt_csupr α _ x s ι δ'ᵒᵈ _ f bdd h
#align upper_semicontinuous_within_at_cinfi upperSemicontinuousWithinAt_cinfi

theorem upperSemicontinuousWithinAt_infᵢ {f : ι → α → δ}
    (h : ∀ i, UpperSemicontinuousWithinAt (f i) s x) :
    UpperSemicontinuousWithinAt (fun x' => ⨅ i, f i x') s x :=
  @lowerSemicontinuousWithinAt_supᵢ α _ x s ι δᵒᵈ _ f h
#align upper_semicontinuous_within_at_infi upperSemicontinuousWithinAt_infᵢ

theorem upperSemicontinuousWithinAt_binfi {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, UpperSemicontinuousWithinAt (f i hi) s x) :
    UpperSemicontinuousWithinAt (fun x' => ⨅ (i) (hi), f i hi x') s x :=
  upperSemicontinuousWithinAt_infᵢ fun i => upperSemicontinuousWithinAt_infᵢ fun hi => h i hi
#align upper_semicontinuous_within_at_binfi upperSemicontinuousWithinAt_binfi

theorem upperSemicontinuousAt_cinfi {f : ι → α → δ'}
    (bdd : ∀ᶠ y in 𝓝 x, BddBelow (range fun i => f i y)) (h : ∀ i, UpperSemicontinuousAt (f i) x) :
    UpperSemicontinuousAt (fun x' => ⨅ i, f i x') x :=
  @lowerSemicontinuousAt_csupr α _ x ι δ'ᵒᵈ _ f bdd h
#align upper_semicontinuous_at_cinfi upperSemicontinuousAt_cinfi

theorem upperSemicontinuousAt_infᵢ {f : ι → α → δ} (h : ∀ i, UpperSemicontinuousAt (f i) x) :
    UpperSemicontinuousAt (fun x' => ⨅ i, f i x') x :=
  @lowerSemicontinuousAt_supᵢ α _ x ι δᵒᵈ _ f h
#align upper_semicontinuous_at_infi upperSemicontinuousAt_infᵢ

theorem upperSemicontinuousAt_binfi {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, UpperSemicontinuousAt (f i hi) x) :
    UpperSemicontinuousAt (fun x' => ⨅ (i) (hi), f i hi x') x :=
  upperSemicontinuousAt_infᵢ fun i => upperSemicontinuousAt_infᵢ fun hi => h i hi
#align upper_semicontinuous_at_binfi upperSemicontinuousAt_binfi

theorem upperSemicontinuousOn_cinfi {f : ι → α → δ'}
    (bdd : ∀ x ∈ s, BddBelow (range fun i => f i x)) (h : ∀ i, UpperSemicontinuousOn (f i) s) :
    UpperSemicontinuousOn (fun x' => ⨅ i, f i x') s := fun x hx =>
  upperSemicontinuousWithinAt_cinfi (eventually_nhdsWithin_of_forall bdd) fun i => h i x hx
#align upper_semicontinuous_on_cinfi upperSemicontinuousOn_cinfi

theorem upperSemicontinuousOn_infᵢ {f : ι → α → δ} (h : ∀ i, UpperSemicontinuousOn (f i) s) :
    UpperSemicontinuousOn (fun x' => ⨅ i, f i x') s := fun x hx =>
  upperSemicontinuousWithinAt_infᵢ fun i => h i x hx
#align upper_semicontinuous_on_infi upperSemicontinuousOn_infᵢ

theorem upperSemicontinuousOn_binfi {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, UpperSemicontinuousOn (f i hi) s) :
    UpperSemicontinuousOn (fun x' => ⨅ (i) (hi), f i hi x') s :=
  upperSemicontinuousOn_infᵢ fun i => upperSemicontinuousOn_infᵢ fun hi => h i hi
#align upper_semicontinuous_on_binfi upperSemicontinuousOn_binfi

theorem upperSemicontinuous_cinfi {f : ι → α → δ'} (bdd : ∀ x, BddBelow (range fun i => f i x))
    (h : ∀ i, UpperSemicontinuous (f i)) : UpperSemicontinuous fun x' => ⨅ i, f i x' := fun x =>
  upperSemicontinuousAt_cinfi (eventually_of_forall bdd) fun i => h i x
#align upper_semicontinuous_cinfi upperSemicontinuous_cinfi

theorem upperSemicontinuous_infᵢ {f : ι → α → δ} (h : ∀ i, UpperSemicontinuous (f i)) :
    UpperSemicontinuous fun x' => ⨅ i, f i x' := fun x => upperSemicontinuousAt_infᵢ fun i => h i x
#align upper_semicontinuous_infi upperSemicontinuous_infᵢ

theorem upperSemicontinuous_binfi {p : ι → Prop} {f : ∀ (i) (_h : p i), α → δ}
    (h : ∀ i hi, UpperSemicontinuous (f i hi)) :
    UpperSemicontinuous fun x' => ⨅ (i) (hi), f i hi x' :=
  upperSemicontinuous_infᵢ fun i => upperSemicontinuous_infᵢ fun hi => h i hi
#align upper_semicontinuous_binfi upperSemicontinuous_binfi

end

section

variable {γ : Type _} [LinearOrder γ] [TopologicalSpace γ] [OrderTopology γ]

theorem continuousWithinAt_iff_lower_upperSemicontinuousWithinAt {f : α → γ} :
    ContinuousWithinAt f s x ↔
      LowerSemicontinuousWithinAt f s x ∧ UpperSemicontinuousWithinAt f s x := by
  refine' ⟨fun h => ⟨h.lowerSemicontinuousWithinAt, h.upperSemicontinuousWithinAt⟩, _⟩
  rintro ⟨h₁, h₂⟩
  intro v hv
  simp only [Filter.mem_map]
  by_cases Hl : ∃ l, l < f x
  · rcases exists_Ioc_subset_of_mem_nhds hv Hl with ⟨l, lfx, hl⟩
    by_cases Hu : ∃ u, f x < u
    · rcases exists_Ico_subset_of_mem_nhds hv Hu with ⟨u, fxu, hu⟩
      filter_upwards [h₁ l lfx, h₂ u fxu]with a lfa fau
      cases' le_or_gt (f a) (f x) with h h
      · exact hl ⟨lfa, h⟩
      · exact hu ⟨le_of_lt h, fau⟩
    · simp only [not_exists, not_lt] at Hu
      filter_upwards [h₁ l lfx]with a lfa using hl ⟨lfa, Hu (f a)⟩
  · simp only [not_exists, not_lt] at Hl
    by_cases Hu : ∃ u, f x < u
    · rcases exists_Ico_subset_of_mem_nhds hv Hu with ⟨u, fxu, hu⟩
      filter_upwards [h₂ u fxu]with a lfa
      apply hu
      exact ⟨Hl (f a), lfa⟩
    · simp only [not_exists, not_lt] at Hu
      apply Filter.eventually_of_forall
      intro a
      have : f a = f x := le_antisymm (Hu _) (Hl _)
      rw [this]
      exact mem_of_mem_nhds hv
#align continuous_within_at_iff_lower_upper_semicontinuous_within_at continuousWithinAt_iff_lower_upperSemicontinuousWithinAt

theorem continuousAt_iff_lower_upperSemicontinuousAt {f : α → γ} :
    ContinuousAt f x ↔ LowerSemicontinuousAt f x ∧ UpperSemicontinuousAt f x := by
  simp_rw [← continuousWithinAt_univ, ← lowerSemicontinuousWithinAt_univ_iff, ←
    upperSemicontinuousWithinAt_univ_iff, continuousWithinAt_iff_lower_upperSemicontinuousWithinAt]
#align continuous_at_iff_lower_upper_semicontinuous_at continuousAt_iff_lower_upperSemicontinuousAt

theorem continuousOn_iff_lower_upperSemicontinuousOn {f : α → γ} :
    ContinuousOn f s ↔ LowerSemicontinuousOn f s ∧ UpperSemicontinuousOn f s := by
  simp only [ContinuousOn, continuousWithinAt_iff_lower_upperSemicontinuousWithinAt]
  exact
    ⟨fun H => ⟨fun x hx => (H x hx).1, fun x hx => (H x hx).2⟩, fun H x hx => ⟨H.1 x hx, H.2 x hx⟩⟩
#align continuous_on_iff_lower_upper_semicontinuous_on continuousOn_iff_lower_upperSemicontinuousOn

theorem continuous_iff_lower_upperSemicontinuous {f : α → γ} :
    Continuous f ↔ LowerSemicontinuous f ∧ UpperSemicontinuous f := by
  simp_rw [continuous_iff_continuousOn_univ, continuousOn_iff_lower_upperSemicontinuousOn,
    lowerSemicontinuousOn_univ_iff, upperSemicontinuousOn_univ_iff]
#align continuous_iff_lower_upper_semicontinuous continuous_iff_lower_upperSemicontinuous

end


/-
Copyright (c) 2022 Yaël Dillies, Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Violeta Hernández Palacios, Grayson Burton, Vladimir Ivanov
-/
import data.nat.interval
import data.int.succ_pred
import order.atoms

/-!
# Graded orders

This file defines graded orders, also known as ranked orders.

A `𝕆`-graded order is an order `α` equipped with a distinguished "grade" function `α → 𝕆` which
should be understood as giving the "height" of the elements. Usual graded orders are `ℕ`-graded,
cograded orders are `ℕᵒᵈ`-graded, but we can also grade by `ℤ`, and polytopes are naturally
`fin n`-graded.

Visually, `grade ℕ a` is the height of `a` in the Hasse diagram of `α`.

## Main declarations

* `grade_order`: Graded order.
* `grade_min_order`: Graded order where minimal elements have minimal grades.
* `grade_max_order`: Graded order where maximal elements have maximal grades.
* `grade_bounded_order`: Graded order where minimal elements have minimal grades and maximal
  elements have maximal grades.
* `grade`: The grade of an element. Because an order can admit several gradings, the first argument
  is the order we grade by.
* `grade_max_order`: Graded orders with maximal elements. All maximal elements have the same grade.
* `max_grade`: The maximum grade in a `grade_max_order`.
* `order_embedding.grade`: The grade of an element in a linear order as an order embedding.

## How to grade your order

Here are the translations between common references and our `grade_order`:
* [Stanley][stanley2012] defines a graded order of rank `n` as an order where all maximal chains
  have "length" `n` (so the number of elements of a chain is `n + 1`). This corresponds to
  `grade_bounded_order (fin (n + 1)) α`.
* [Engel][engel1997]'s ranked orders are somewhere between `grade_order ℕ α` and
  `grade_min_order ℕ α`, in that he requires `∃ a, is_min a ∧ grade ℕ a + 0` rather than
  `∀ a, is_min a → grade ℕ a = 0`. He defines a graded order as an order where all minimal elements
  have grade `0` and all maximal elements have the same grade. This is roughly a less bundled
  version of `grade_bounded_order (fin n) α`, assuming we discard orders with infinite chains.

## Implementation notes

One possible definition of graded orders is as the bounded orders whose flags (maximal chains)
all have the same finite length (see Stanley p. 99). However, this means that all graded orders must
have minimal and maximal elements and that the grade is not data.

Instead, we define graded orders by their grade function, without talking about flags yet.

## References

* [Konrad Engel, *Sperner Theory*][engel1997]
* [Richard Stanley, *Enumerative Combinatorics*][stanley2012]
-/

set_option old_structure_cmd true

open finset nat order_dual

variables {𝕆 ℙ α β : Type*}

/-- An `𝕆`-graded order is an order `α` equipped with a strictly monotone function `grade 𝕆 : α → 𝕆`
which preserves order covering (`covby`). -/
class grade_order (𝕆 α : Type*) [preorder 𝕆] [preorder α] :=
(grade : α → 𝕆)
(grade_strict_mono : strict_mono grade)
(covby_grade ⦃a b : α⦄ : a ⋖ b → grade a ⋖ grade b)

/-- A `𝕆`-graded order where minimal elements have minimal grades. -/
class grade_min_order (𝕆 α : Type*) [preorder 𝕆] [preorder α] extends grade_order 𝕆 α :=
(is_min_grade ⦃a : α⦄ : is_min a → is_min (grade a))

/-- A `𝕆`-graded order where maximal elements have maximal grades. -/
class grade_max_order (𝕆 α : Type*) [preorder 𝕆] [preorder α] extends grade_order 𝕆 α :=
(is_max_grade ⦃a : α⦄ : is_max a → is_max (grade a))

/-- A `𝕆`-graded order where minimal elements have minimal grades and maximal elements have maximal
grades. -/
class grade_bounded_order (𝕆 α : Type*) [preorder 𝕆] [preorder α]
  extends grade_min_order 𝕆 α, grade_max_order 𝕆 α

section preorder -- grading
variables [preorder 𝕆]

section preorder -- graded order
variables [preorder α]

section grade_order
variables (𝕆) [grade_order 𝕆 α] {a b : α}

/-- The grade of an element in a graded order. Morally, this is the number of elements you need to
go down by to get to `⊥`. -/
def grade : α → 𝕆 := grade_order.grade

protected lemma covby.grade (h : a ⋖ b) : grade 𝕆 a ⋖ grade 𝕆 b := grade_order.covby_grade h

variables {𝕆}

lemma grade_strict_mono : strict_mono (grade 𝕆 : α → 𝕆) := grade_order.grade_strict_mono

lemma covby_iff_lt_covby_grade : a ⋖ b ↔ a < b ∧ grade 𝕆 a ⋖ grade 𝕆 b :=
⟨λ h, ⟨h.1, h.grade _⟩, and.imp_right $ λ h c ha hb,
  h.2 (grade_strict_mono ha) $ grade_strict_mono hb⟩

end grade_order

section grade_min_order
variables (𝕆) [grade_min_order 𝕆 α] {a : α}

protected lemma is_min.grade (h : is_min a) : is_min (grade 𝕆 a) := grade_min_order.is_min_grade h

variables {𝕆}

@[simp] lemma is_min_grade_iff : is_min (grade 𝕆 a) ↔ is_min a :=
⟨grade_strict_mono.is_min_of_apply, is_min.grade _⟩

end grade_min_order

section grade_max_order
variables (𝕆) [grade_max_order 𝕆 α] {a : α}

protected lemma is_max.grade (h : is_max a) : is_max (grade 𝕆 a) := grade_max_order.is_max_grade h

variables {𝕆}

@[simp] lemma is_max_grade_iff : is_max (grade 𝕆 a) ↔ is_max a :=
⟨grade_strict_mono.is_max_of_apply, is_max.grade _⟩

end grade_max_order
end preorder -- graded order

lemma grade_mono [partial_order α] [grade_order 𝕆 α] : monotone (grade 𝕆 : α → 𝕆) :=
grade_strict_mono.monotone

section linear_order -- graded order
variables [linear_order α] [grade_order 𝕆 α] {a b : α}

lemma grade_injective : function.injective (grade 𝕆 : α → 𝕆) := grade_strict_mono.injective
@[simp] lemma grade_le_grade_iff : grade 𝕆 a ≤ grade 𝕆 b ↔ a ≤ b := grade_strict_mono.le_iff_le
@[simp] lemma grade_lt_grade_iff : grade 𝕆 a < grade 𝕆 b ↔ a < b := grade_strict_mono.lt_iff_lt
@[simp] lemma grade_eq_grade_iff : grade 𝕆 a = grade 𝕆 b ↔ a = b := grade_injective.eq_iff
lemma grade_ne_grade_iff : grade 𝕆 a ≠ grade 𝕆 b ↔ a ≠ b := grade_injective.ne_iff

lemma grade_covby_grade_iff : grade 𝕆 a ⋖ grade 𝕆 b ↔ a ⋖ b :=
(covby_iff_lt_covby_grade.trans $ and_iff_right_of_imp $ λ h, grade_lt_grade_iff.1 h.1).symm

end linear_order -- graded order
end preorder -- grading

section partial_order
variables [partial_order 𝕆] [preorder α]

@[simp] lemma grade_bot [order_bot 𝕆] [order_bot α] [grade_min_order 𝕆 α] : grade 𝕆 (⊥ : α) = ⊥ :=
(is_min_bot.grade _).eq_bot

@[simp] lemma grade_top [order_top 𝕆] [order_top α] [grade_max_order 𝕆 α] : grade 𝕆 (⊤ : α) = ⊤ :=
(is_max_top.grade _).eq_top

end partial_order

/-! ### Instances -/

variables [preorder 𝕆] [preorder ℙ] [preorder α] [preorder β]

instance preorder.to_grade_bounded_order : grade_bounded_order α α :=
{ grade := id,
  is_min_grade := λ _, id,
  is_max_grade := λ _, id,
  grade_strict_mono := strict_mono_id,
  covby_grade := λ a b, id }

@[simp] lemma grade_self (a : α) : grade α a = a := rfl

/-! #### Dual -/

instance [grade_order 𝕆 α] : grade_order 𝕆ᵒᵈ αᵒᵈ :=
{ grade := to_dual ∘ grade 𝕆 ∘ of_dual,
  grade_strict_mono := grade_strict_mono.dual,
  covby_grade := λ a b h, (h.of_dual.grade _).to_dual }

instance [grade_max_order 𝕆 α] : grade_min_order 𝕆ᵒᵈ αᵒᵈ :=
{ is_min_grade := λ _, is_max.grade _,
  ..order_dual.grade_order }

instance [grade_min_order 𝕆 α] : grade_max_order 𝕆ᵒᵈ αᵒᵈ :=
{ is_max_grade := λ _, is_min.grade _,
  ..order_dual.grade_order }

instance [grade_bounded_order 𝕆 α] : grade_bounded_order 𝕆ᵒᵈ αᵒᵈ :=
{ ..order_dual.grade_min_order, ..order_dual.grade_max_order }

@[simp] lemma grade_to_dual [grade_order 𝕆 α] (a : α) :
  grade 𝕆ᵒᵈ (to_dual a) = to_dual (grade 𝕆 a) := rfl
@[simp] lemma grade_of_dual [grade_order 𝕆 α] (a : αᵒᵈ) :
  grade 𝕆 (of_dual a) = of_dual (grade 𝕆ᵒᵈ a) := rfl

/-! #### Lifting a graded order -/

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_order.lift_left [grade_order 𝕆 α] (f : 𝕆 → ℙ) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) : grade_order ℙ α :=
{ grade := f ∘ grade 𝕆,
  grade_strict_mono := hf.comp grade_strict_mono,
  covby_grade := λ a b h, hcovby _ _ $ h.grade _ }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_min_order.lift_left [grade_min_order 𝕆 α] (f : 𝕆 → ℙ) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, is_min a → is_min (f a)) :
  grade_min_order ℙ α :=
{ is_min_grade := λ a ha, hmin _ $ ha.grade _,
  ..grade_order.lift_left f hf hcovby }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_max_order.lift_left [grade_max_order 𝕆 α] (f : 𝕆 → ℙ) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmax : ∀ a, is_max a → is_max (f a)) :
  grade_max_order ℙ α :=
{ is_max_grade := λ a ha, hmax _ $ ha.grade _,
  ..grade_order.lift_left f hf hcovby }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_bounded_order.lift_left [grade_bounded_order 𝕆 α] (f : 𝕆 → ℙ) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, is_min a → is_min (f a))
  (hmax : ∀ a, is_max a → is_max (f a)) :
  grade_bounded_order ℙ α :=
{ ..grade_min_order.lift_left f hf hcovby hmin, ..grade_max_order.lift_left f hf hcovby hmax }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_order.lift_right [grade_order 𝕆 β] (f : α → β) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) : grade_order 𝕆 α :=
{ grade := grade 𝕆 ∘ f,
  grade_strict_mono := grade_strict_mono.comp hf,
  covby_grade := λ a b h, (hcovby _ _ h).grade _ }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_min_order.lift_right [grade_min_order 𝕆 β] (f : α → β) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, is_min a → is_min (f a)) :
  grade_min_order 𝕆 α :=
{ is_min_grade := λ a ha, (hmin _ ha).grade _,
  ..grade_order.lift_right f hf hcovby }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_max_order.lift_right [grade_max_order 𝕆 β] (f : α → β) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmax : ∀ a, is_max a → is_max (f a)) :
  grade_max_order 𝕆 α :=
{ is_max_grade := λ a ha, (hmax _ ha).grade _,
  ..grade_order.lift_right f hf hcovby }

/-- Lifts a graded order along a strictly monotone function. -/
@[reducible] -- See note [reducible non-instances]
def grade_bounded_order.lift_right [grade_bounded_order 𝕆 β] (f : α → β) (hf : strict_mono f)
  (hcovby : ∀ a b, a ⋖ b → f a ⋖ f b) (hmin : ∀ a, is_min a → is_min (f a))
  (hmax : ∀ a, is_max a → is_max (f a)) : grade_bounded_order 𝕆 α :=
{ ..grade_min_order.lift_right f hf hcovby hmin, ..grade_max_order.lift_right f hf hcovby hmax }

/-! #### `fin n`-graded to `ℕ`-graded to `ℤ`-graded -/

/-- A `fin n`-graded order is also `ℕ`-graded. We do not mark this an instance because `n` is not
inferrable. -/
@[reducible] -- See note [reducible non-instances]
def grade_order.fin_to_nat (n : ℕ) [grade_order (fin n) α] : grade_order ℕ α :=
grade_order.lift_left (_ : fin n → ℕ) fin.coe_strict_mono $ λ _ _, covby.coe_fin

/-- A `fin n`-graded order is also `ℕ`-graded. We do not mark this an instance because `n` is not
inferrable. -/
@[reducible] -- See note [reducible non-instances]
def grade_min_order.fin_to_nat (n : ℕ) [grade_min_order (fin n) α] : grade_min_order ℕ α :=
grade_min_order.lift_left (_ : fin n → ℕ) fin.coe_strict_mono (λ _ _, covby.coe_fin) $ λ a h, begin
    unfreezingI { cases n },
    { exact (@fin.elim0 (λ _, false) $ grade (fin 0) a).elim },
    rw [h.eq_bot, fin.bot_eq_zero],
    exact is_min_bot,
  end

instance grade_order.nat_to_int [grade_order ℕ α] : grade_order ℤ α :=
grade_order.lift_left _ int.coe_nat_strict_mono $ λ _ _, covby.cast_int


/- Defines basic lemmas for equality  -/
import data.vector
import ..list.simplify_eq
import ..list.take_drop_lemmas
import ..subtype

universe variables u

namespace vector

variable {α : Type u}
variable {n : ℕ}

local infix `++`:65 := vector.append

theorem cons_eq_cons {n : ℕ} (a b : α) (x y : vector α n)
: a :: x = b :: y ↔ a = b ∧ x = y :=
begin
  apply iff.intro,
  {
    -- Reduce to list primitives
    cases x with xv xp,
    cases y with yv yp,
    simp [ vector.cons ],
    -- Simplify equalities
    simp [ @subtype.mk_eq_mk (list α) (λ (l : list α), @list.length α l = nat.succ n)
         ],
    cc,
  },
  {
    intro h,
    rw [and.left h, and.right h],
  },
end

@[simp]
theorem append_eq_append {m n : ℕ} (a b : vector α m) (x y : vector α n)
: a ++ x = b ++ y ↔ a = b ∧ x = y :=
begin
  apply iff.intro,
  { -- Reduce intro list functions
    cases a with av ap,
    cases b with bv bp,
    cases x with xv xp,
    cases y with yv yp,
    unfold vector.append,

    have h : av^.length = bv^.length, { simp [ap, bp] },
    -- Simplify hypothesis into conjunction av = bv ∧ xv = yv
    intro p,
    have q := congr_arg subtype.val p,
    simp [list.append_eq_take_drop, h, nat.sub_self] at q,

    -- Prove equalities
    simp [and.left q, and.right q],
  },
  { -- Prove a = b & x = y -> a +++ x = b +++ y
    intro h,
    rw [and.left h, and.right h],
  },
end

end vector


import .basic
import ..equiv
import algebra.big_operators.finprod

noncomputable theory

open set function sigma

open_locale classical
open_locale big_operators

namespace matroid

section direct_sum

variables {ι : Type*} {E : ι → Type*} {M : ∀ i, matroid (E i)}
/-- The direct sum of an `ι`-indexed collection of matroids `(M i : matroid E i)`. A set is a base
  if and only if its intersection with each matroid is a base -/
def direct_sum (M : ∀ i, matroid (E i)) :
  matroid (Σ i, E i) :=
{ base := λ B, (∀ (i : ι), (M i).base ((sigma.mk i) ⁻¹' B)),
  exists_base' := begin
    choose B hB using λ i, (M i).exists_base,
    refine ⟨⋃ (i : ι), (sigma.mk i) '' (B i), λ i, _⟩,
    rw preimage_mk_Union_image_mk,
    exact hB i,
  end,
  base_exchange' := begin
    rintros B₁ B₂ hB₁ hB₂ ⟨j,x⟩ hx,
    obtain ⟨y,hy,hBy⟩  := (hB₁ j).exchange (hB₂ j) hx,
    refine ⟨sigma.mk j y, hy, λ i, _⟩,
    { obtain (rfl | hne) := eq_or_ne i j,
      { convert hBy, ext, simp},
    convert hB₁ i using 1,
    rw [←union_singleton, preimage_union, preimage_diff],
    -- ext,
    convert (union_empty _),
    {ext, simpa using hne},
    convert diff_empty.symm,
    ext,
    simpa using hne},
  end}

@[simp] lemma direct_sum_base_iff {B : set (Σ i, E i)} :
  (direct_sum M).base B ↔ ∀ i, (M i).base ((sigma.mk i) ⁻¹' B) :=
iff.rfl

lemma eq_union_image_bases_of_direct_sum_base {B : set (Σ i, E i)} (h : (direct_sum M).base B) :
  ∃ Bs : (∀ i, set (E i)), (B = ⋃ i, (sigma.mk i '' (Bs i))) ∧ (∀ i, (M i).base (Bs i)) :=
⟨λ i, sigma.mk i ⁻¹' B, by rw ←eq_Union_image_preimage_mk B, direct_sum_base_iff.mp h⟩

variables [finite ι] [∀ i, finite (E i)]

@[simp] lemma direct_sum_indep_iff {I : set (Σ i, E i)} :
  (direct_sum M).indep I ↔ ∀ i, (M i).indep ((sigma.mk i) ⁻¹' I) :=
begin
  simp_rw [indep_iff_subset_base, sigma.subset_iff, direct_sum_base_iff, preimage_subset_iff,
    mem_preimage],
  refine ⟨λ ⟨B, hB, hIB⟩ i, ⟨sigma.mk i ⁻¹' B, hB i, λ a ha, hIB _ _ ha⟩, λ h, _⟩,
  choose! f hf using h,
  refine ⟨⋃ i, sigma.mk i '' (f i), λ i, _, λ i a ha, mem_Union_of_mem i _⟩,
  { rw sigma.preimage_mk_Union_image_mk, exact (hf i).1},
  simpa using (hf i).2 a ha,
end

lemma eq_union_image_indeps_of_direct_sum_indep {I : set (Σ i, E i)} (h : (direct_sum M).indep I) :
  ∃ Is : (∀ i, set (E i)), (I = ⋃ i, (sigma.mk i '' (Is i))) ∧ (∀ i, (M i).indep (Is i)) :=
⟨λ i, sigma.mk i ⁻¹' I, by rw ←eq_Union_image_preimage_mk I, direct_sum_indep_iff.mp h⟩

@[simp] lemma direct_sum_basis_iff {I X : set (Σ i, E i)} :
  (direct_sum M).basis I X ↔ ∀ i, (M i).basis (sigma.mk i ⁻¹' I) (sigma.mk i ⁻¹' X) :=
begin
  simp_rw [basis_iff, direct_sum_indep_iff],
  refine ⟨λ h i, ⟨h.1 i,preimage_mono h.2.1,λ J hJ hIJ hJX, _⟩,
          λ h, ⟨λ i, (h i).1,sigma.subset_iff.mpr (λ i, (h i).2.1), λ J hJ hIJ hJX, _⟩⟩,
  { have h' := h.2.2 (I ∪ sigma.mk i '' J) (λ j, _) (subset_union_left _ _)
      (union_subset h.2.1 (by simpa)),
    { rwa [h', preimage_union, preimage_image_eq _ sigma_mk_injective, union_eq_right_iff_subset]},
    obtain (rfl | hne) := eq_or_ne j i,
    { rwa [preimage_union, preimage_image_eq _ sigma_mk_injective,
        union_eq_right_iff_subset.mpr hIJ]},
    rw [preimage_union, preimage_image_sigma_mk_of_ne hne, union_empty],
    exact h.1 j},
  rw sigma.eq_iff_forall_preimage_mk_eq,
  rw sigma.subset_iff at hIJ hJX,
  exact λ i, (h i).2.2 _ (hJ _) (hIJ _) (hJX _),
end

@[simp] lemma direct_sum_r_eq (X : set (Σ i, E i)) :
  (direct_sum M).r X = ∑ᶠ i, (M i).r (sigma.mk i ⁻¹' X) :=
begin
  obtain ⟨I, hI⟩ := (direct_sum M).exists_basis X,
  rw [←hI.r, hI.indep.r, sigma.ncard_eq_finsum_ncard_image_preimage_mk _ (to_finite I)],
  rw [direct_sum_basis_iff] at hI,
  congr',
  ext i,
  rw [←(hI i).r, (hI i).indep.r, ncard_image_of_injective _ sigma_mk_injective],
end

/- This proof is a bit of a disaster. -/
@[simp] lemma direct_sum_circuit_iff {C : set (Σ i, E i)} :
  (direct_sum M).circuit C ↔ ∃ i C₀, (M i).circuit C₀ ∧ C = sigma.mk i '' C₀ :=
begin
  refine ⟨λ hC, _,_⟩,
  { have h_dep : ∃ i, ¬(M i).indep (sigma.mk i ⁻¹' C),
    { by_contra' h, rw [←direct_sum_indep_iff] at h, exact hC.dep h, },
    obtain ⟨i,hi⟩ := h_dep,

    have h_forall : ∀ j ≠ i, sigma.mk j ⁻¹' C = ∅,
    { refine λ j hj, eq_empty_of_forall_not_mem (λ e he, hi _),
      have hjC : (⟨j,e⟩ : (Σ i, E i)) ∈ C, from he,
      convert ((direct_sum_indep_iff.mp (hC.diff_singleton_indep hjC)) i).subset rfl.subset using 1,
      rw [preimage_diff, eq_comm],
      convert diff_empty,
      convert preimage_image_sigma_mk_of_ne hj.symm {e},
      rw [image_singleton]},

    have hC₀ : C = sigma.mk i '' (sigma.mk i ⁻¹' C),
    { nth_rewrite 0 ←Union_image_preimage_sigma_mk_eq_self C,
      refine subset_antisymm (Union_subset (λ j, _)) (subset_Union _ i),
      obtain (rfl | hne) := eq_or_ne j i,
      { exact subset.rfl},
      rintro x ⟨h,h',rfl⟩,
      exact (not_mem_empty _ ((h_forall _ hne).subset h')).elim, },
    refine ⟨_,_,_,hC₀⟩,
    simp_rw [circuit_iff_dep_forall_diff_singleton_indep, direct_sum_indep_iff] at hC ⊢,
    refine ⟨hi, λ e he, _⟩,
    convert hC.2 ⟨i,e⟩ he i using 1,
    ext,
    simp},
  simp_rw [circuit_iff_dep_forall_diff_singleton_indep, direct_sum_indep_iff, not_forall],
  rintro ⟨i,C, ⟨hC,hmin⟩, rfl⟩,

  refine ⟨⟨i,by rwa preimage_image_eq _ sigma_mk_injective⟩, _⟩,
  rintro ⟨j,e⟩ ⟨f,hf,⟨h'⟩⟩ j,
  rw preimage_diff,
  obtain (rfl | hne) := eq_or_ne i j,
  { rw [preimage_image_eq _ sigma_mk_injective], convert hmin f hf, ext, simp},
  convert (M j).empty_indep,
  rw [preimage_image_sigma_mk_of_ne hne.symm, empty_diff],
end

@[simp] lemma direct_sum_flat_iff {F : set (Σ i, E i)} :
  (direct_sum M).flat F ↔ ∀ i, (M i).flat (sigma.mk i ⁻¹' F) :=
begin
  simp_rw [flat_iff_forall_circuit, direct_sum_circuit_iff],
  refine ⟨λ h i C e hC heC hss, h (sigma.mk i '' C) ⟨i,e⟩ ⟨_,_,hC,rfl⟩ ⟨e,heC,rfl⟩ _,λ h C e, _⟩,
  { simp_rw [diff_singleton_subset_iff, image_subset_iff, ←union_singleton, preimage_union] at
      ⊢ hss,
    convert hss,
    ext,
    simp},
  rintro ⟨i,C₀,hC₀,rfl⟩ ⟨f,hf,rfl⟩ h',
  refine h i C₀ f hC₀ hf _,
  rintro x ⟨hxC₀,(hne : x ≠ f)⟩,
  exact h' ⟨⟨_,hxC₀,rfl⟩,by simpa⟩,
end

end direct_sum

-- section prod_sum

-- variables {ι E : Type*} [finite ι] [finite E] {M : ι → matroid E}

-- def prod_sum (M : ι → matroid E) :
--   matroid (ι × E) :=
-- (direct_sum M).congr_equiv (equiv.sigma_equiv_prod ι E)

-- @[simp] lemma prod_sum_base_iff {B : set (ι × E)} :
--   (prod_sum M).base B ↔ ∀ i, (M i).base (prod.mk i ⁻¹' B) :=
-- iff.rfl

-- @[simp] lemma prod_sum_indep_iff {I : set (ι × E)} :
--   (prod_sum M).indep I ↔ ∀ i, (M i).indep (prod.mk i ⁻¹' I) :=
-- begin
--   convert @congr_equiv_apply_indep _ _ _ _ (equiv.sigma_equiv_prod ι E) (direct_sum M) I,
--   simp_rw [direct_sum_indep_iff],
--   convert rfl,
-- end

-- @[simp] lemma prod_sum_circuit_iff {C : set (ι × E)} :
--   (prod_sum M).circuit C ↔ ∃ i C₀, (M i).circuit C₀ ∧ C = prod.mk i '' C₀ :=
-- begin
--   set e := equiv.sigma_equiv_prod ι E with he,
--   convert @congr_equiv_apply_circuit _ _ _ _ e (direct_sum M) C,
--   simp_rw [direct_sum_circuit_iff, eq_iff_iff, preimage_eq_iff_eq_image e.bijective, image_image],
--   convert iff.rfl,
-- end

-- @[simp] lemma prod_sum_flat_iff {F : set (ι × E)} :
--   (prod_sum M).flat F ↔ ∀ i, (M i).indep (prod.mk i ⁻¹' F) :=
-- begin

-- end

-- end prod_sum

section sum

variables {ι E₁ E₂ : Type*} {E : ι → Type*} {M₁ : matroid E₁} {M₂ : matroid E₂}

def sum (M₁ : matroid E₁) (M₂ : matroid E₂) :
  matroid (E₁ ⊕ E₂) :=
{ base := λ B, M₁.base (sum.inl ⁻¹' B) ∧ M₂.base (sum.inr ⁻¹' B),
  exists_base' :=
  begin
    obtain ⟨⟨B₁,hB₁⟩,⟨B₂,hB₂⟩⟩ := ⟨M₁.exists_base, M₂.exists_base⟩,
    refine ⟨sum.inl '' B₁ ∪ sum.inr '' B₂, _⟩,
    simp only [preimage_union, preimage_inl_image_inr, union_empty,
      preimage_inr_image_inl, empty_union],
    rw [preimage_image_eq _ (sum.inl_injective), preimage_image_eq _ (sum.inr_injective)],
    exact ⟨hB₁,hB₂⟩,
  end,
  base_exchange' :=
  begin
    rintro B B' hB hB' (x | x) hx,
    { rw [←mem_preimage, preimage_diff] at hx,
      obtain ⟨y,hy,hBy⟩ := hB.1.exchange hB'.1 hx,
      rw [←preimage_diff, mem_preimage] at hy,
      refine ⟨_, hy, by {convert hBy, ext, simp}, _⟩,
      convert hB.2 using 1,
      ext,
      simp},
    rw [←mem_preimage, preimage_diff] at hx,
    obtain ⟨y,hy,hBy⟩ := hB.2.exchange hB'.2 hx,
    rw [←preimage_diff, mem_preimage] at hy,
    refine ⟨_, hy, _, by {convert hBy, ext, simp}⟩,
    convert hB.1 using 1,
    ext,
    simp,
  end}

@[simp] lemma sum_base_iff {B : set (E₁ ⊕ E₂)} :
  (M₁.sum M₂).base B ↔ M₁.base (sum.inl ⁻¹' B) ∧ M₂.base (sum.inr ⁻¹' B) :=
iff.rfl

-- /-- Gluing together of an `ι`-indexed collection of different matroids on the same ground set.
--   This is a tamer special case of sigma, and is used in the proof of matroid union. -/
-- def copy_sum {E : Type*} (M : ι → matroid E) : matroid (ι × E) :=
--   (direct_sum M).congr_equiv (equiv.sigma_equiv_prod ι E)

-- @[simp] lemma copy_sum_base_iff {E : Type*} {M : ι → matroid E} {B : set (ι × E)}:
--   (copy_sum M).base B ↔ ∀ i, (M i).base (prod.mk i ⁻¹' B) :=
-- by {simp only [copy_sum, congr_equiv_apply_base, direct_sum_base_iff], congr'}

-- @[simp] lemma copy_sum_indep_iff {E : Type*} [finite ι] [finite E] {M : ι → matroid E}
-- {I : set (ι × E)}:
--   (copy_sum M).indep I ↔ ∀ i, (M i).indep (prod.mk i ⁻¹' I) :=
-- by {simp only [copy_sum, congr_equiv_apply_indep, direct_sum_indep_iff], congr'}

end sum

section partition

variables {ι : Type*} {E : ι → Type*} {rk : ι → ℕ} [finite ι] [∀ i, finite (E i)]

/-- The direct sum of uniform matroids with prescribed ranks -/
def partition_matroid (E : ι → Type*) [∀ i, finite (E i)] (rk : ι → ℕ) :
  matroid (Σ i, E i) :=
direct_sum (λ i, unif (E i) (rk i))

lemma partition_matroid_base_iff (h_le : ∀ i, rk i ≤ nat.card (E i)) {B : set (Σ i, E i)} :
  (partition_matroid E rk).base B ↔ ∀ i, (sigma.mk i ⁻¹' B).ncard = rk i :=
begin
  simp [partition_matroid],
  refine ⟨λ h i, _, λ h i, _⟩,
  { specialize h i,
    rwa [unif_base_iff (h_le i), sigma.ncard_preimage_mk] at h},
  rw [unif_base_iff (h_le i), sigma.ncard_preimage_mk],
  exact h i,
end

@[simp] lemma partition_matroid_indep_iff {I : set (Σ i, E i)} :
  (partition_matroid E rk).indep I ↔ ∀ i, (I ∩ fst ⁻¹' {i}).ncard ≤ rk i :=
begin
  simp only [partition_matroid, direct_sum_indep_iff, unif_indep_iff],
  refine forall_congr (λ i, _),
  rw sigma.ncard_preimage_mk,
end

@[simp] lemma partition_matroid_r_eq (X : set (Σ i, E i)) :
  (partition_matroid E rk).r X = ∑ᶠ i, min (rk i) (X ∩ fst ⁻¹' {i}).ncard :=
begin
  simp only [partition_matroid, direct_sum_r_eq, unif_r],
  apply finsum_congr (λ i, _),
  rw sigma.ncard_preimage_mk,
end

lemma partition_one_flat_iff {F : set (Σ i, E i)} :
  (partition_matroid E 1).flat F ↔ ∀ i, (fst ⁻¹' {i} ⊆ F) ∨ (disjoint F (fst ⁻¹' {i})) :=
begin
  simp only [partition_matroid, pi.one_apply, direct_sum_flat_iff, unif_flat_iff, ncard_preimage_mk,
    nat.lt_one_iff, ncard_eq_zero],
  refine forall_congr (λ i, _ ),
  convert iff.rfl,
  { simp_rw [eq_univ_iff_forall, eq_iff_iff],
    exact ⟨λ h x, h (rfl : sigma.fst ⟨i,x⟩ = i), λ h, by {rintro ⟨j,e⟩ (rfl : j = i), exact h _}⟩},
  simp_rw [eq_iff_iff, ←disjoint_iff_inter_eq_empty],
end

end partition

section partition_on

variables {E ι : Type*} [finite E] [finite ι] {f : E → ι} {rks : ι → ℕ}
/-- The partition matroid on ground set `E` induced by a partition `f : E → ι` of the ground set
  and ranks `rks : ι → ℕ`. -/
def partition_matroid_on (f : E → ι) (rks : ι → ℕ) :
  matroid E :=
(partition_matroid (λ i, {x // f x = i}) rks).congr_equiv (equiv.sigma_fiber_equiv f)

@[simp] lemma partition_matroid_on_indep_iff {I : set E}:
  (partition_matroid_on f rks).indep I ↔ ∀ i, (I ∩ f ⁻¹' {i}).ncard ≤ rks i :=
begin
  simp only [partition_matroid_on, congr_equiv_apply_indep, partition_matroid_indep_iff],
  apply forall_congr (λ i, _),
  rw [←ncard_image_of_injective _ (equiv.sigma_fiber_equiv f).symm.injective,
    ←preimage_equiv_eq_image_symm, preimage_inter],
  convert iff.rfl,
  ext x,
  obtain ⟨j, x, rfl⟩ := x,
  simp
end

@[simp] lemma partition_matroid_on_r_eq (X : set E) :
  (partition_matroid_on f rks).r X = ∑ᶠ i, min (rks i) (X ∩ f ⁻¹' {i}).ncard :=
begin
  simp only [partition_matroid_on, congr_equiv_apply_r, partition_matroid_r_eq],
  refine finsum_congr (λ i, _ ),
  rw [←ncard_image_of_injective _ (equiv.sigma_fiber_equiv f).symm.injective,
    ←preimage_equiv_eq_image_symm, preimage_inter],
  convert rfl,
  ext x,
  obtain ⟨j, x, rfl⟩ := x,
  simp,
end

lemma partition_matroid_on_one_r_eq (X : set E) :
  (partition_matroid_on f 1).r X = (f '' X).ncard :=
begin
  simp only [partition_matroid_on_r_eq, pi.one_apply],
  rw [←finsum_mem_one],
  apply finsum_congr (λ i, _),
  rw [finsum_eq_if, min_one_ncard_eq_ite (to_finite (X ∩ f ⁻¹' {i}))],
  convert rfl,
end

end partition_on

end matroid


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import algebra.invertible
import ring_theory.adjoin.fg
import linear_algebra.basis
import algebra.algebra.tower
import algebra.algebra.restrict_scalars

/-!
# Towers of algebras

We set up the basic theory of algebra towers.
An algebra tower A/S/R is expressed by having instances of `algebra A S`,
`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

In `field_theory/tower.lean` we use this to prove the tower law for finite extensions,
that if `R` and `S` are both fields, then `[A:R] = [A:S] [S:A]`.

In this file we prepare the main lemma:
if `{bi | i ∈ I}` is an `R`-basis of `S` and `{cj | j ∈ J}` is a `S`-basis
of `A`, then `{bi cj | i ∈ I, j ∈ J}` is an `R`-basis of `A`. This statement does not require the
base rings to be a field, so we also generalize the lemma to rings in this file.
-/

open_locale pointwise
universes u v w u₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A B)

/-- Suppose that `R -> S -> A` is a tower of algebras.
If an element `r : R` is invertible in `S`, then it is invertible in `A`. -/
def invertible.algebra_tower (r : R) [invertible (algebra_map R S r)] :
  invertible (algebra_map R A r) :=
invertible.copy (invertible.map (algebra_map S A) (algebra_map R S r)) (algebra_map R A r)
  (is_scalar_tower.algebra_map_apply R S A r)

/-- A natural number that is invertible when coerced to `R` is also invertible
when coerced to any `R`-algebra. -/
def invertible_algebra_coe_nat (n : ℕ) [inv : invertible (n : R)] :
  invertible (n : A) :=
by { haveI : invertible (algebra_map ℕ R n) := inv, exact invertible.algebra_tower ℕ R A n }

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

end comm_semiring

end is_scalar_tower

namespace algebra

theorem adjoin_algebra_map (R : Type u) (S : Type v) (A : Type w)
  [comm_semiring R] [comm_semiring S] [semiring A] [algebra R S] [algebra S A] [algebra R A]
  [is_scalar_tower R S A] (s : set S) :
  adjoin R (algebra_map S A '' s) =
    subalgebra.map (adjoin R s) (is_scalar_tower.to_alg_hom R S A) :=
le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)

lemma adjoin_restrict_scalars (C D E : Type*) [comm_semiring C] [comm_semiring D] [comm_semiring E]
  [algebra C D] [algebra C E] [algebra D E] [is_scalar_tower C D E] (S : set E) :
(algebra.adjoin D S).restrict_scalars C =
  (algebra.adjoin
    ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) S).restrict_scalars C :=
begin
  suffices : set.range (algebra_map D E) =
    set.range (algebra_map ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) E),
  { ext x, change x ∈ subsemiring.closure (_ ∪ S) ↔ x ∈ subsemiring.closure (_ ∪ S), rw this },
  ext x,
  split,
  { rintros ⟨y, hy⟩,
    exact ⟨⟨algebra_map D E y, ⟨y, ⟨algebra.mem_top, rfl⟩⟩⟩, hy⟩ },
  { rintros ⟨⟨y, ⟨z, ⟨h0, h1⟩⟩⟩, h2⟩,
    exact ⟨z, eq.trans h1 h2⟩ },
end

lemma adjoin_res_eq_adjoin_res (C D E F : Type*) [comm_semiring C] [comm_semiring D]
  [comm_semiring E] [comm_semiring F] [algebra C D] [algebra C E] [algebra C F] [algebra D F]
  [algebra E F] [is_scalar_tower C D F] [is_scalar_tower C E F] {S : set D} {T : set E}
  (hS : algebra.adjoin C S = ⊤) (hT : algebra.adjoin C T = ⊤) :
(algebra.adjoin E (algebra_map D F '' S)).restrict_scalars C =
  (algebra.adjoin D (algebra_map E F '' T)).restrict_scalars C :=
by rw [adjoin_restrict_scalars C E, adjoin_restrict_scalars C D, ←hS, ←hT, ←algebra.adjoin_image,
  ←algebra.adjoin_image, ←alg_hom.coe_to_ring_hom, ←alg_hom.coe_to_ring_hom,
  is_scalar_tower.coe_to_alg_hom, is_scalar_tower.coe_to_alg_hom, ←adjoin_union_eq_adjoin_adjoin,
  ←adjoin_union_eq_adjoin_adjoin, set.union_comm]

end algebra

section
open_locale classical
lemma algebra.fg_trans' {R S A : Type*} [comm_semiring R] [comm_semiring S] [comm_semiring A]
  [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]
  (hRS : (⊤ : subalgebra R S).fg) (hSA : (⊤ : subalgebra S A).fg) :
  (⊤ : subalgebra R A).fg :=
let ⟨s, hs⟩ := hRS, ⟨t, ht⟩ := hSA in ⟨s.image (algebra_map S A) ∪ t,
by rw [finset.coe_union, finset.coe_image, algebra.adjoin_union_eq_adjoin_adjoin,
  algebra.adjoin_algebra_map, hs, algebra.map_top, is_scalar_tower.adjoin_range_to_alg_hom, ht,
  subalgebra.restrict_scalars_top]⟩
end

section algebra_map_coeffs

variables {R} (A) {ι M : Type*} [comm_semiring R] [semiring A] [add_comm_monoid M]
variables [algebra R A] [module A M] [module R M] [is_scalar_tower R A M]
variables (b : basis ι R M) (h : function.bijective (algebra_map R A))

/-- If `R` and `A` have a bijective `algebra_map R A` and act identically on `M`,
then a basis for `M` as `R`-module is also a basis for `M` as `R'`-module. -/
@[simps]
noncomputable def basis.algebra_map_coeffs : basis ι A M :=
b.map_coeffs (ring_equiv.of_bijective _ h) (λ c x, by simp)

lemma basis.algebra_map_coeffs_apply (i : ι) : b.algebra_map_coeffs A h i = b i :=
b.map_coeffs_apply _ _ _

@[simp] lemma basis.coe_algebra_map_coeffs : (b.algebra_map_coeffs A h : ι → M) = b :=
b.coe_map_coeffs _ _

end algebra_map_coeffs

section semiring

open finsupp
open_locale big_operators classical
universes v₁ w₁

variables {R S A}
variables [comm_semiring R] [semiring S] [add_comm_monoid A]
variables [algebra R S] [module S A] [module R A] [is_scalar_tower R S A]

theorem linear_independent_smul {ι : Type v₁} {b : ι → S} {ι' : Type w₁} {c : ι' → A}
  (hb : linear_independent R b) (hc : linear_independent S c) :
  linear_independent R (λ p : ι × ι', b p.1 • c p.2) :=
begin
  rw linear_independent_iff' at hb hc, rw linear_independent_iff'', rintros s g hg hsg ⟨i, k⟩,
  by_cases hik : (i, k) ∈ s,
  { have h1 : ∑ i in (s.image prod.fst).product (s.image prod.snd), g i • b i.1 • c i.2 = 0,
    { rw ← hsg, exact (finset.sum_subset finset.subset_product $ λ p _ hp,
        show g p • b p.1 • c p.2 = 0, by rw [hg p hp, zero_smul]).symm },
    rw finset.sum_product_right at h1,
    simp_rw [← smul_assoc, ← finset.sum_smul] at h1,
    exact hb _ _ (hc _ _ h1 k (finset.mem_image_of_mem _ hik)) i (finset.mem_image_of_mem _ hik) },
  exact hg _ hik
end

/-- `basis.smul (b : basis ι R S) (c : basis ι S A)` is the `R`-basis on `A`
where the `(i, j)`th basis vector is `b i • c j`. -/
noncomputable def basis.smul {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) : basis (ι × ι') R A :=
basis.of_repr ((c.repr.restrict_scalars R) ≪≫ₗ
  ((finsupp.lcongr (equiv.refl _) b.repr) ≪≫ₗ
  ((finsupp_prod_lequiv R).symm ≪≫ₗ
  ((finsupp.lcongr (equiv.prod_comm ι' ι) (linear_equiv.refl _ _))))))

@[simp] theorem basis.smul_repr {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (x ij):
  (b.smul c).repr x ij = b.repr (c.repr x ij.2) ij.1 :=
by simp [basis.smul]

theorem basis.smul_repr_mk {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (x i j):
  (b.smul c).repr x (i, j) = b.repr (c.repr x j) i :=
b.smul_repr c x (i, j)

@[simp] theorem basis.smul_apply {ι : Type v₁} {ι' : Type w₁}
  (b : basis ι R S) (c : basis ι' S A) (ij) :
  (b.smul c) ij = b ij.1 • c ij.2 :=
begin
  obtain ⟨i, j⟩ := ij,
  rw basis.apply_eq_iff,
  ext ⟨i', j'⟩,
  rw [basis.smul_repr, linear_equiv.map_smul, basis.repr_self, finsupp.smul_apply,
      finsupp.single_apply],
  dsimp only,
  split_ifs with hi,
  { simp [hi, finsupp.single_apply] },
  { simp [hi] },
end

end semiring

section ring

variables {R S}
variables [comm_ring R] [ring S] [algebra R S]

lemma basis.algebra_map_injective {ι : Type*} [no_zero_divisors R] [nontrivial S]
  (b : basis ι R S) :
  function.injective (algebra_map R S) :=
have no_zero_smul_divisors R S := b.no_zero_smul_divisors,
by exactI no_zero_smul_divisors.algebra_map_injective R S

end ring

section artin_tate

variables (C : Type*)

section semiring

variables [comm_semiring A] [comm_semiring B] [semiring C]
variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]

open finset submodule
open_locale classical

lemma exists_subalgebra_of_fg (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg) :
  ∃ B₀ : subalgebra A B, B₀.fg ∧ (⊤ : submodule B₀ C).fg :=
begin
  cases hAC with x hx,
  cases hBC with y hy, have := hy,
  simp_rw [eq_top_iff', mem_span_finset] at this, choose f hf,
  let s : finset B := (finset.product (x ∪ (y * y)) y).image (function.uncurry f),
  have hsx : ∀ (xi ∈ x) (yj ∈ y), f xi yj ∈ s := λ xi hxi yj hyj,
    show function.uncurry f (xi, yj) ∈ s,
    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_left _ hxi, hyj⟩,
  have hsy : ∀ (yi yj yk ∈ y), f (yi * yj) yk ∈ s := λ yi hyi yj hyj yk hyk,
    show function.uncurry f (yi * yj, yk) ∈ s,
    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_right _ $ finset.mul_mem_mul hyi hyj, hyk⟩,
  have hxy : ∀ xi ∈ x, xi ∈ span (algebra.adjoin A (↑s : set B))
               (↑(insert 1 y : finset C) : set C) :=
    λ xi hxi, hf xi ▸ sum_mem (λ yj hyj, smul_mem
      (span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C))
      ⟨f xi yj, algebra.subset_adjoin $ hsx xi hxi yj hyj⟩
      (subset_span $ mem_insert_of_mem hyj)),
  have hyy : span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) *
      span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) ≤
    span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C),
  { rw [span_mul_span, span_le, coe_insert], rintros _ ⟨yi, yj, rfl | hyi, rfl | hyj, rfl⟩,
    { rw mul_one, exact subset_span (set.mem_insert _ _) },
    { rw one_mul, exact subset_span (set.mem_insert_of_mem _ hyj) },
    { rw mul_one, exact subset_span (set.mem_insert_of_mem _ hyi) },
    { rw ← hf (yi * yj), exact set_like.mem_coe.2 (sum_mem $ λ yk hyk, smul_mem
        (span (algebra.adjoin A (↑s : set B)) (insert 1 ↑y : set C))
        ⟨f (yi * yj) yk, algebra.subset_adjoin $ hsy yi hyi yj hyj yk hyk⟩
        (subset_span $ set.mem_insert_of_mem _ hyk : yk ∈ _)) } },
  refine ⟨algebra.adjoin A (↑s : set B), subalgebra.fg_adjoin_finset _, insert 1 y, _⟩,
  refine restrict_scalars_injective A _ _ _,
  rw [restrict_scalars_top, eq_top_iff, ← algebra.top_to_submodule, ← hx,
    algebra.adjoin_eq_span, span_le],
  refine λ r hr, submonoid.closure_induction hr (λ c hc, hxy c hc)
    (subset_span $ mem_insert_self _ _) (λ p q hp hq, hyy $ submodule.mul_mem_mul hp hq)
end

end semiring

section ring

variables [comm_ring A] [comm_ring B] [comm_ring C]
variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]

/-- Artin--Tate lemma: if A ⊆ B ⊆ C is a chain of subrings of commutative rings, and
A is noetherian, and C is algebra-finite over A, and C is module-finite over B,
then B is algebra-finite over A.

References: Atiyah--Macdonald Proposition 7.8; Stacks 00IS; Altman--Kleiman 16.17. -/
theorem fg_of_fg_of_fg [is_noetherian_ring A]
  (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg)
  (hBCi : function.injective (algebra_map B C)) :
  (⊤ : subalgebra A B).fg :=
let ⟨B₀, hAB₀, hB₀C⟩ := exists_subalgebra_of_fg A B C hAC hBC in
algebra.fg_trans' (B₀.fg_top.2 hAB₀) $ subalgebra.fg_of_submodule_fg $
have is_noetherian_ring B₀, from is_noetherian_ring_of_fg hAB₀,
have is_noetherian B₀ C, by exactI is_noetherian_of_fg_of_noetherian' hB₀C,
by exactI fg_of_injective (is_scalar_tower.to_alg_hom B₀ B C).to_linear_map hBCi

end ring

end artin_tate

section alg_hom_tower

variables {A} {C D : Type*} [comm_semiring A] [comm_semiring C] [comm_semiring D]
  [algebra A C] [algebra A D]

variables (f : C →ₐ[A] D) (B) [comm_semiring B] [algebra A B] [algebra B C] [is_scalar_tower A B C]

/-- Restrict the domain of an `alg_hom`. -/
def alg_hom.restrict_domain : B →ₐ[A] D := f.comp (is_scalar_tower.to_alg_hom A B C)

/-- Extend the scalars of an `alg_hom`. -/
def alg_hom.extend_scalars : @alg_hom B C D _ _ _ _ (f.restrict_domain B).to_ring_hom.to_algebra :=
{ commutes' := λ _, rfl .. f }

variables {B}

/-- `alg_hom`s from the top of a tower are equivalent to a pair of `alg_hom`s. -/
def alg_hom_equiv_sigma :
  (C →ₐ[A] D) ≃ Σ (f : B →ₐ[A] D), @alg_hom B C D _ _ _ _ f.to_ring_hom.to_algebra :=
{ to_fun := λ f, ⟨f.restrict_domain B, f.extend_scalars B⟩,
  inv_fun := λ fg,
    let alg := fg.1.to_ring_hom.to_algebra in by exactI fg.2.restrict_scalars A,
  left_inv := λ f, by { dsimp only, ext, refl },
  right_inv :=
  begin
    rintros ⟨⟨f, _, _, _, _, _⟩, g, _, _, _, _, hg⟩,
    obtain rfl : f = λ x, g (algebra_map B C x) := by { ext, exact (hg x).symm },
    refl,
  end }

end alg_hom_tower


variables (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
begin
  apply iff.intro,
    intro h,
    split,
      intro x,
      apply (h x).left,
    intro x,
    exact (h x).right,
  intro h,
  intro x,
  split,
    apply h.left,
  apply h.right
end
example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
begin
  intros,
  apply a,
  apply a_1
end
example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
begin
  intros,
  cases a,
    left,
    apply a,
  right,
  apply a
end