/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
! This file was ported from Lean 3 source module order.bounds.basic
! leanprover-community/mathlib commit 3310acfa9787aa171db6d4cba3945f6f275fe9f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Intervals.Basic
import Mathlib.Data.Set.NAry

/-!
# Upper / lower bounds

In this file we define:
* `upperBounds`, `lowerBounds` : the set of upper bounds (resp., lower bounds) of a set;
* `BddAbove s`, `BddBelow s` : the set `s` is bounded above (resp., below), i.e., the set of upper
  (resp., lower) bounds of `s` is nonempty;
* `IsLeast s a`, `IsGreatest s a` : `a` is a least (resp., greatest) element of `s`;
  for a partial order, it is unique if exists;
* `IsLUB s a`, `IsGLB s a` : `a` is a least upper bound (resp., a greatest lower bound)
  of `s`; for a partial order, it is unique if exists.
We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
formulas for `∅`, `univ`, and intervals.
-/

open Function Set

open OrderDual (toDual ofDual)

universe u v w x

variable {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

section

variable [Preorder α] [Preorder β] {s t : Set α} {a b : α}

/-!
### Definitions
-/

/-- The set of upper bounds of a set. -/
def upperBounds (s : Set α) : Set α :=
  { x | ∀ ⦃a⦄, a ∈ s → a ≤ x }
#align upper_bounds upperBounds

/-- The set of lower bounds of a set. -/
def lowerBounds (s : Set α) : Set α :=
  { x | ∀ ⦃a⦄, a ∈ s → x ≤ a }
#align lower_bounds lowerBounds

/-- A set is bounded above if there exists an upper bound. -/
def BddAbove (s : Set α) :=
  (upperBounds s).Nonempty
#align bdd_above BddAbove

/-- A set is bounded below if there exists a lower bound. -/
def BddBelow (s : Set α) :=
  (lowerBounds s).Nonempty
#align bdd_below BddBelow

/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
def IsLeast (s : Set α) (a : α) : Prop :=
  a ∈ s ∧ a ∈ lowerBounds s
#align is_least IsLeast

/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
def IsGreatest (s : Set α) (a : α) : Prop :=
  a ∈ s ∧ a ∈ upperBounds s
#align is_greatest IsGreatest

/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
def IsLUB (s : Set α) : α → Prop :=
  IsLeast (upperBounds s)
#align is_lub IsLUB

/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
def IsGLB (s : Set α) : α → Prop :=
  IsGreatest (lowerBounds s)
#align is_glb IsGLB

theorem mem_upperBounds : a ∈ upperBounds s ↔ ∀ x ∈ s, x ≤ a :=
  Iff.rfl
#align mem_upper_bounds mem_upperBounds

theorem mem_lowerBounds : a ∈ lowerBounds s ↔ ∀ x ∈ s, a ≤ x :=
  Iff.rfl
#align mem_lower_bounds mem_lowerBounds

theorem bddAbove_def : BddAbove s ↔ ∃ x, ∀ y ∈ s, y ≤ x :=
  Iff.rfl
#align bdd_above_def bddAbove_def

theorem bddBelow_def : BddBelow s ↔ ∃ x, ∀ y ∈ s, x ≤ y :=
  Iff.rfl
#align bdd_below_def bddBelow_def

theorem bot_mem_lowerBounds [OrderBot α] (s : Set α) : ⊥ ∈ lowerBounds s := fun _ _ => bot_le
#align bot_mem_lower_bounds bot_mem_lowerBounds

theorem top_mem_upperBounds [OrderTop α] (s : Set α) : ⊤ ∈ upperBounds s := fun _ _ => le_top
#align top_mem_upper_bounds top_mem_upperBounds

@[simp]
theorem isLeast_bot_iff [OrderBot α] : IsLeast s ⊥ ↔ ⊥ ∈ s :=
  and_iff_left <| bot_mem_lowerBounds _
#align is_least_bot_iff isLeast_bot_iff

@[simp]
theorem isGreatest_top_iff [OrderTop α] : IsGreatest s ⊤ ↔ ⊤ ∈ s :=
  and_iff_left <| top_mem_upperBounds _
#align is_greatest_top_iff isGreatest_top_iff

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
is not greater than or equal to `y`. This version only assumes `Preorder` structure and uses
`¬(y ≤ x)`. A version for linear orders is called `not_bddAbove_iff`. -/
theorem not_bddAbove_iff' : ¬BddAbove s ↔ ∀ x, ∃ y ∈ s, ¬y ≤ x := by
  simp [BddAbove, upperBounds, Set.Nonempty]
#align not_bdd_above_iff' not_bddAbove_iff'

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
is not less than or equal to `y`. This version only assumes `Preorder` structure and uses
`¬(x ≤ y)`. A version for linear orders is called `not_bddBelow_iff`. -/
theorem not_bddBelow_iff' : ¬BddBelow s ↔ ∀ x, ∃ y ∈ s, ¬x ≤ y :=
  @not_bddAbove_iff' αᵒᵈ _ _
#align not_bdd_below_iff' not_bddBelow_iff'

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
than `x`. A version for preorders is called `not_bddAbove_iff'`. -/
theorem not_bddAbove_iff {α : Type _} [LinearOrder α] {s : Set α} :
    ¬BddAbove s ↔ ∀ x, ∃ y ∈ s, x < y := by
  simp only [not_bddAbove_iff', not_le]
#align not_bdd_above_iff not_bddAbove_iff

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
than `x`. A version for preorders is called `not_bddBelow_iff'`. -/
theorem not_bddBelow_iff {α : Type _} [LinearOrder α] {s : Set α} :
    ¬BddBelow s ↔ ∀ x, ∃ y ∈ s, y < x :=
  @not_bddAbove_iff αᵒᵈ _ _
#align not_bdd_below_iff not_bddBelow_iff

theorem BddAbove.dual (h : BddAbove s) : BddBelow (ofDual ⁻¹' s) :=
  h
#align bdd_above.dual BddAbove.dual

theorem BddBelow.dual (h : BddBelow s) : BddAbove (ofDual ⁻¹' s) :=
  h
#align bdd_below.dual BddBelow.dual

theorem IsLeast.dual (h : IsLeast s a) : IsGreatest (ofDual ⁻¹' s) (toDual a) :=
  h
#align is_least.dual IsLeast.dual

theorem IsGreatest.dual (h : IsGreatest s a) : IsLeast (ofDual ⁻¹' s) (toDual a) :=
  h
#align is_greatest.dual IsGreatest.dual

theorem IsLUB.dual (h : IsLUB s a) : IsGLB (ofDual ⁻¹' s) (toDual a) :=
  h
#align is_lub.dual IsLUB.dual

theorem IsGLB.dual (h : IsGLB s a) : IsLUB (ofDual ⁻¹' s) (toDual a) :=
  h
#align is_glb.dual IsGLB.dual

/-- If `a` is the least element of a set `s`, then subtype `s` is an order with bottom element. -/
@[reducible]
def IsLeast.orderBot (h : IsLeast s a) :
    OrderBot s where
  bot := ⟨a, h.1⟩
  bot_le := Subtype.forall.2 h.2
#align is_least.order_bot IsLeast.orderBot

/-- If `a` is the greatest element of a set `s`, then subtype `s` is an order with top element. -/
@[reducible]
def IsGreatest.orderTop (h : IsGreatest s a) :
    OrderTop s where
  top := ⟨a, h.1⟩
  le_top := Subtype.forall.2 h.2
#align is_greatest.order_top IsGreatest.orderTop

/-!
### Monotonicity
-/

theorem upperBounds_mono_set ⦃s t : Set α⦄ (hst : s ⊆ t) : upperBounds t ⊆ upperBounds s :=
  fun _ hb _ h => hb <| hst h
#align upper_bounds_mono_set upperBounds_mono_set

theorem lowerBounds_mono_set ⦃s t : Set α⦄ (hst : s ⊆ t) : lowerBounds t ⊆ lowerBounds s :=
  fun _ hb _ h => hb <| hst h
#align lower_bounds_mono_set lowerBounds_mono_set

theorem upperBounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : a ∈ upperBounds s → b ∈ upperBounds s :=
  fun ha _ h => le_trans (ha h) hab
#align upper_bounds_mono_mem upperBounds_mono_mem

theorem lowerBounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : b ∈ lowerBounds s → a ∈ lowerBounds s :=
  fun hb _ h => le_trans hab (hb h)
#align lower_bounds_mono_mem lowerBounds_mono_mem

theorem upperBounds_mono ⦃s t : Set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
    a ∈ upperBounds t → b ∈ upperBounds s := fun ha =>
  upperBounds_mono_set hst <| upperBounds_mono_mem hab ha
#align upper_bounds_mono upperBounds_mono

theorem lowerBounds_mono ⦃s t : Set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
    b ∈ lowerBounds t → a ∈ lowerBounds s := fun hb =>
  lowerBounds_mono_set hst <| lowerBounds_mono_mem hab hb
#align lower_bounds_mono lowerBounds_mono

/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
theorem BddAbove.mono ⦃s t : Set α⦄ (h : s ⊆ t) : BddAbove t → BddAbove s :=
  Nonempty.mono <| upperBounds_mono_set h
#align bdd_above.mono BddAbove.mono

/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
theorem BddBelow.mono ⦃s t : Set α⦄ (h : s ⊆ t) : BddBelow t → BddBelow s :=
  Nonempty.mono <| lowerBounds_mono_set h
#align bdd_below.mono BddBelow.mono

/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
set `t`, `s ⊆ t ⊆ p`. -/
theorem IsLUB.of_subset_of_superset {s t p : Set α} (hs : IsLUB s a) (hp : IsLUB p a) (hst : s ⊆ t)
    (htp : t ⊆ p) : IsLUB t a :=
  ⟨upperBounds_mono_set htp hp.1, lowerBounds_mono_set (upperBounds_mono_set hst) hs.2⟩
#align is_lub.of_subset_of_superset IsLUB.of_subset_of_superset

/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
set `t`, `s ⊆ t ⊆ p`. -/
theorem IsGLB.of_subset_of_superset {s t p : Set α} (hs : IsGLB s a) (hp : IsGLB p a) (hst : s ⊆ t)
    (htp : t ⊆ p) : IsGLB t a :=
  hs.dual.of_subset_of_superset hp hst htp
#align is_glb.of_subset_of_superset IsGLB.of_subset_of_superset

theorem IsLeast.mono (ha : IsLeast s a) (hb : IsLeast t b) (hst : s ⊆ t) : b ≤ a :=
  hb.2 (hst ha.1)
#align is_least.mono IsLeast.mono

theorem IsGreatest.mono (ha : IsGreatest s a) (hb : IsGreatest t b) (hst : s ⊆ t) : a ≤ b :=
  hb.2 (hst ha.1)
#align is_greatest.mono IsGreatest.mono

theorem IsLUB.mono (ha : IsLUB s a) (hb : IsLUB t b) (hst : s ⊆ t) : a ≤ b :=
  IsLeast.mono hb ha <| upperBounds_mono_set hst
#align is_lub.mono IsLUB.mono

theorem IsGLB.mono (ha : IsGLB s a) (hb : IsGLB t b) (hst : s ⊆ t) : b ≤ a :=
  IsGreatest.mono hb ha <| lowerBounds_mono_set hst
#align is_glb.mono IsGLB.mono

theorem subset_lowerBounds_upperBounds (s : Set α) : s ⊆ lowerBounds (upperBounds s) :=
  fun _ hx _ hy => hy hx
#align subset_lower_bounds_upper_bounds subset_lowerBounds_upperBounds

theorem subset_upperBounds_lowerBounds (s : Set α) : s ⊆ upperBounds (lowerBounds s) :=
  fun _ hx _ hy => hy hx
#align subset_upper_bounds_lower_bounds subset_upperBounds_lowerBounds

theorem Set.Nonempty.bddAbove_lowerBounds (hs : s.Nonempty) : BddAbove (lowerBounds s) :=
  hs.mono (subset_upperBounds_lowerBounds s)
#align set.nonempty.bdd_above_lower_bounds Set.Nonempty.bddAbove_lowerBounds

theorem Set.Nonempty.bddBelow_upperBounds (hs : s.Nonempty) : BddBelow (upperBounds s) :=
  hs.mono (subset_lowerBounds_upperBounds s)
#align set.nonempty.bdd_below_upper_bounds Set.Nonempty.bddBelow_upperBounds

/-!
### Conversions
-/

theorem IsLeast.isGLB (h : IsLeast s a) : IsGLB s a :=
  ⟨h.2, fun _ hb => hb h.1⟩
#align is_least.is_glb IsLeast.isGLB

theorem IsGreatest.isLUB (h : IsGreatest s a) : IsLUB s a :=
  ⟨h.2, fun _ hb => hb h.1⟩
#align is_greatest.is_lub IsGreatest.isLUB

theorem IsLUB.upperBounds_eq (h : IsLUB s a) : upperBounds s = Ici a :=
  Set.ext fun _ => ⟨fun hb => h.2 hb, fun hb => upperBounds_mono_mem hb h.1⟩
#align is_lub.upper_bounds_eq IsLUB.upperBounds_eq

theorem IsGLB.lowerBounds_eq (h : IsGLB s a) : lowerBounds s = Iic a :=
  h.dual.upperBounds_eq
#align is_glb.lower_bounds_eq IsGLB.lowerBounds_eq

theorem IsLeast.lowerBounds_eq (h : IsLeast s a) : lowerBounds s = Iic a :=
  h.isGLB.lowerBounds_eq
#align is_least.lower_bounds_eq IsLeast.lowerBounds_eq

theorem IsGreatest.upperBounds_eq (h : IsGreatest s a) : upperBounds s = Ici a :=
  h.isLUB.upperBounds_eq
#align is_greatest.upper_bounds_eq IsGreatest.upperBounds_eq

-- porting note: new lemma
theorem IsGreatest.lt_iff (h : IsGreatest s a) : a < b ↔ ∀ x ∈ s, x < b :=
  ⟨fun hlt _x hx => (h.2 hx).trans_lt hlt, fun h' => h' _ h.1⟩

-- porting note: new lemma
theorem IsLeast.lt_iff (h : IsLeast s a) : b < a ↔ ∀ x ∈ s, b < x :=
  h.dual.lt_iff

theorem isLUB_le_iff (h : IsLUB s a) : a ≤ b ↔ b ∈ upperBounds s := by
  rw [h.upperBounds_eq]
  rfl
#align is_lub_le_iff isLUB_le_iff

theorem le_isGLB_iff (h : IsGLB s a) : b ≤ a ↔ b ∈ lowerBounds s := by
  rw [h.lowerBounds_eq]
  rfl
#align le_is_glb_iff le_isGLB_iff

theorem isLUB_iff_le_iff : IsLUB s a ↔ ∀ b, a ≤ b ↔ b ∈ upperBounds s :=
  ⟨fun h _ => isLUB_le_iff h, fun H => ⟨(H _).1 le_rfl, fun b hb => (H b).2 hb⟩⟩
#align is_lub_iff_le_iff isLUB_iff_le_iff

theorem isGLB_iff_le_iff : IsGLB s a ↔ ∀ b, b ≤ a ↔ b ∈ lowerBounds s :=
  @isLUB_iff_le_iff αᵒᵈ _ _ _
#align is_glb_iff_le_iff isGLB_iff_le_iff

/-- If `s` has a least upper bound, then it is bounded above. -/
theorem IsLUB.bddAbove (h : IsLUB s a) : BddAbove s :=
  ⟨a, h.1⟩
#align is_lub.bdd_above IsLUB.bddAbove

/-- If `s` has a greatest lower bound, then it is bounded below. -/
theorem IsGLB.bddBelow (h : IsGLB s a) : BddBelow s :=
  ⟨a, h.1⟩
#align is_glb.bdd_below IsGLB.bddBelow

/-- If `s` has a greatest element, then it is bounded above. -/
theorem IsGreatest.bddAbove (h : IsGreatest s a) : BddAbove s :=
  ⟨a, h.2⟩
#align is_greatest.bdd_above IsGreatest.bddAbove

/-- If `s` has a least element, then it is bounded below. -/
theorem IsLeast.bddBelow (h : IsLeast s a) : BddBelow s :=
  ⟨a, h.2⟩
#align is_least.bdd_below IsLeast.bddBelow

theorem IsLeast.nonempty (h : IsLeast s a) : s.Nonempty :=
  ⟨a, h.1⟩
#align is_least.nonempty IsLeast.nonempty

theorem IsGreatest.nonempty (h : IsGreatest s a) : s.Nonempty :=
  ⟨a, h.1⟩
#align is_greatest.nonempty IsGreatest.nonempty

/-!
### Union and intersection
-/

@[simp]
theorem upperBounds_union : upperBounds (s ∪ t) = upperBounds s ∩ upperBounds t :=
  Subset.antisymm (fun _ hb => ⟨fun _ hx => hb (Or.inl hx), fun _ hx => hb (Or.inr hx)⟩)
    fun _ hb _ hx => hx.elim (fun hs => hb.1 hs) fun ht => hb.2 ht
#align upper_bounds_union upperBounds_union

@[simp]
theorem lowerBounds_union : lowerBounds (s ∪ t) = lowerBounds s ∩ lowerBounds t :=
  @upperBounds_union αᵒᵈ _ s t
#align lower_bounds_union lowerBounds_union

theorem union_upperBounds_subset_upperBounds_inter :
    upperBounds s ∪ upperBounds t ⊆ upperBounds (s ∩ t) :=
  union_subset (upperBounds_mono_set <| inter_subset_left _ _)
    (upperBounds_mono_set <| inter_subset_right _ _)
#align union_upper_bounds_subset_upper_bounds_inter union_upperBounds_subset_upperBounds_inter

theorem union_lowerBounds_subset_lowerBounds_inter :
    lowerBounds s ∪ lowerBounds t ⊆ lowerBounds (s ∩ t) :=
  @union_upperBounds_subset_upperBounds_inter αᵒᵈ _ s t
#align union_lower_bounds_subset_lower_bounds_inter union_lowerBounds_subset_lowerBounds_inter

theorem isLeast_union_iff {a : α} {s t : Set α} :
    IsLeast (s ∪ t) a ↔ IsLeast s a ∧ a ∈ lowerBounds t ∨ a ∈ lowerBounds s ∧ IsLeast t a := by
  simp [IsLeast, lowerBounds_union, or_and_right, and_comm (a := a ∈ t), and_assoc]
#align is_least_union_iff isLeast_union_iff

theorem isGreatest_union_iff :
    IsGreatest (s ∪ t) a ↔
      IsGreatest s a ∧ a ∈ upperBounds t ∨ a ∈ upperBounds s ∧ IsGreatest t a :=
  @isLeast_union_iff αᵒᵈ _ a s t
#align is_greatest_union_iff isGreatest_union_iff

/-- If `s` is bounded, then so is `s ∩ t` -/
theorem BddAbove.inter_of_left (h : BddAbove s) : BddAbove (s ∩ t) :=
  h.mono <| inter_subset_left s t
#align bdd_above.inter_of_left BddAbove.inter_of_left

/-- If `t` is bounded, then so is `s ∩ t` -/
theorem BddAbove.inter_of_right (h : BddAbove t) : BddAbove (s ∩ t) :=
  h.mono <| inter_subset_right s t
#align bdd_above.inter_of_right BddAbove.inter_of_right

/-- If `s` is bounded, then so is `s ∩ t` -/
theorem BddBelow.inter_of_left (h : BddBelow s) : BddBelow (s ∩ t) :=
  h.mono <| inter_subset_left s t
#align bdd_below.inter_of_left BddBelow.inter_of_left

/-- If `t` is bounded, then so is `s ∩ t` -/
theorem BddBelow.inter_of_right (h : BddBelow t) : BddBelow (s ∩ t) :=
  h.mono <| inter_subset_right s t
#align bdd_below.inter_of_right BddBelow.inter_of_right

/-- If `s` and `t` are bounded above sets in a `semilattice_sup`, then so is `s ∪ t`. -/
theorem BddAbove.union [SemilatticeSup γ] {s t : Set γ} :
    BddAbove s → BddAbove t → BddAbove (s ∪ t) := by
  rintro ⟨bs, hs⟩ ⟨bt, ht⟩
  use bs ⊔ bt
  rw [upperBounds_union]
  exact ⟨upperBounds_mono_mem le_sup_left hs, upperBounds_mono_mem le_sup_right ht⟩
#align bdd_above.union BddAbove.union

/-- The union of two sets is bounded above if and only if each of the sets is. -/
theorem bddAbove_union [SemilatticeSup γ] {s t : Set γ} :
    BddAbove (s ∪ t) ↔ BddAbove s ∧ BddAbove t :=
  ⟨fun h => ⟨h.mono <| subset_union_left s t, h.mono <| subset_union_right s t⟩, fun h =>
    h.1.union h.2⟩
#align bdd_above_union bddAbove_union

theorem BddBelow.union [SemilatticeInf γ] {s t : Set γ} :
    BddBelow s → BddBelow t → BddBelow (s ∪ t) :=
  @BddAbove.union γᵒᵈ _ s t
#align bdd_below.union BddBelow.union

/-- The union of two sets is bounded above if and only if each of the sets is.-/
theorem bddBelow_union [SemilatticeInf γ] {s t : Set γ} :
    BddBelow (s ∪ t) ↔ BddBelow s ∧ BddBelow t :=
  @bddAbove_union γᵒᵈ _ s t
#align bdd_below_union bddBelow_union

/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
theorem IsLUB.union [SemilatticeSup γ] {a b : γ} {s t : Set γ} (hs : IsLUB s a) (ht : IsLUB t b) :
    IsLUB (s ∪ t) (a ⊔ b) :=
  ⟨fun _ h =>
    h.casesOn (fun h => le_sup_of_le_left <| hs.left h) fun h => le_sup_of_le_right <| ht.left h,
    fun _ hc =>
    sup_le (hs.right fun _ hd => hc <| Or.inl hd) (ht.right fun _ hd => hc <| Or.inr hd)⟩
#align is_lub.union IsLUB.union

/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
theorem IsGLB.union [SemilatticeInf γ] {a₁ a₂ : γ} {s t : Set γ} (hs : IsGLB s a₁)
    (ht : IsGLB t a₂) : IsGLB (s ∪ t) (a₁ ⊓ a₂) :=
  hs.dual.union ht
#align is_glb.union IsGLB.union

/-- If `a` is the least element of `s` and `b` is the least element of `t`,
then `min a b` is the least element of `s ∪ t`. -/
theorem IsLeast.union [LinearOrder γ] {a b : γ} {s t : Set γ} (ha : IsLeast s a)
    (hb : IsLeast t b) : IsLeast (s ∪ t) (min a b) :=
  ⟨by cases' le_total a b with h h <;> simp [h, ha.1, hb.1], (ha.isGLB.union hb.isGLB).1⟩
#align is_least.union IsLeast.union

/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
then `max a b` is the greatest element of `s ∪ t`. -/
theorem IsGreatest.union [LinearOrder γ] {a b : γ} {s t : Set γ} (ha : IsGreatest s a)
    (hb : IsGreatest t b) : IsGreatest (s ∪ t) (max a b) :=
  ⟨by cases' le_total a b with h h <;> simp [h, ha.1, hb.1], (ha.isLUB.union hb.isLUB).1⟩
#align is_greatest.union IsGreatest.union

theorem IsLUB.inter_Ici_of_mem [LinearOrder γ] {s : Set γ} {a b : γ} (ha : IsLUB s a) (hb : b ∈ s) :
    IsLUB (s ∩ Ici b) a :=
  ⟨fun _ hx => ha.1 hx.1, fun c hc =>
    have hbc : b ≤ c := hc ⟨hb, le_rfl⟩
    ha.2 fun x hx => ((le_total x b).elim fun hxb => hxb.trans hbc) fun hbx => hc ⟨hx, hbx⟩⟩
#align is_lub.inter_Ici_of_mem IsLUB.inter_Ici_of_mem

theorem IsGLB.inter_Iic_of_mem [LinearOrder γ] {s : Set γ} {a b : γ} (ha : IsGLB s a) (hb : b ∈ s) :
    IsGLB (s ∩ Iic b) a :=
  ha.dual.inter_Ici_of_mem hb
#align is_glb.inter_Iic_of_mem IsGLB.inter_Iic_of_mem

theorem bddAbove_iff_exists_ge [SemilatticeSup γ] {s : Set γ} (x₀ : γ) :
    BddAbove s ↔ ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x := by
  rw [bddAbove_def, exists_ge_and_iff_exists]
  exact Monotone.ball fun x _ => monotone_le
#align bdd_above_iff_exists_ge bddAbove_iff_exists_ge

theorem bddBelow_iff_exists_le [SemilatticeInf γ] {s : Set γ} (x₀ : γ) :
    BddBelow s ↔ ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
  bddAbove_iff_exists_ge (toDual x₀)
#align bdd_below_iff_exists_le bddBelow_iff_exists_le

theorem BddAbove.exists_ge [SemilatticeSup γ] {s : Set γ} (hs : BddAbove s) (x₀ : γ) :
    ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
  (bddAbove_iff_exists_ge x₀).mp hs
#align bdd_above.exists_ge BddAbove.exists_ge

theorem BddBelow.exists_le [SemilatticeInf γ] {s : Set γ} (hs : BddBelow s) (x₀ : γ) :
    ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
  (bddBelow_iff_exists_le x₀).mp hs
#align bdd_below.exists_le BddBelow.exists_le

/-!
### Specific sets
#### Unbounded intervals
-/

theorem isLeast_Ici : IsLeast (Ici a) a :=
  ⟨left_mem_Ici, fun _ => id⟩
#align is_least_Ici isLeast_Ici

theorem isGreatest_Iic : IsGreatest (Iic a) a :=
  ⟨right_mem_Iic, fun _ => id⟩
#align is_greatest_Iic isGreatest_Iic

theorem isLUB_Iic : IsLUB (Iic a) a :=
  isGreatest_Iic.isLUB
#align is_lub_Iic isLUB_Iic

theorem isGLB_Ici : IsGLB (Ici a) a :=
  isLeast_Ici.isGLB
#align is_glb_Ici isGLB_Ici

theorem upperBounds_Iic : upperBounds (Iic a) = Ici a :=
  isLUB_Iic.upperBounds_eq
#align upper_bounds_Iic upperBounds_Iic

theorem lowerBounds_Ici : lowerBounds (Ici a) = Iic a :=
  isGLB_Ici.lowerBounds_eq
#align lower_bounds_Ici lowerBounds_Ici

theorem bddAbove_Iic : BddAbove (Iic a) :=
  isLUB_Iic.bddAbove
#align bdd_above_Iic bddAbove_Iic

theorem bddBelow_Ici : BddBelow (Ici a) :=
  isGLB_Ici.bddBelow
#align bdd_below_Ici bddBelow_Ici

theorem bddAbove_Iio : BddAbove (Iio a) :=
  ⟨a, fun _ hx => le_of_lt hx⟩
#align bdd_above_Iio bddAbove_Iio

theorem bddBelow_Ioi : BddBelow (Ioi a) :=
  ⟨a, fun _ hx => le_of_lt hx⟩
#align bdd_below_Ioi bddBelow_Ioi

theorem lub_Iio_le (a : α) (hb : IsLUB (Iio a) b) : b ≤ a :=
  (isLUB_le_iff hb).mpr fun _ hk => le_of_lt hk
#align lub_Iio_le lub_Iio_le

theorem le_glb_Ioi (a : α) (hb : IsGLB (Ioi a) b) : a ≤ b :=
  @lub_Iio_le αᵒᵈ _ _ a hb
#align le_glb_Ioi le_glb_Ioi

theorem lub_Iio_eq_self_or_Iio_eq_Iic [PartialOrder γ] {j : γ} (i : γ) (hj : IsLUB (Iio i) j) :
    j = i ∨ Iio i = Iic j := by
  cases' eq_or_lt_of_le (lub_Iio_le i hj) with hj_eq_i hj_lt_i
  · exact Or.inl hj_eq_i
  · right
    exact Set.ext fun k => ⟨fun hk_lt => hj.1 hk_lt, fun hk_le_j => lt_of_le_of_lt hk_le_j hj_lt_i⟩
#align lub_Iio_eq_self_or_Iio_eq_Iic lub_Iio_eq_self_or_Iio_eq_Iic

theorem glb_Ioi_eq_self_or_Ioi_eq_Ici [PartialOrder γ] {j : γ} (i : γ) (hj : IsGLB (Ioi i) j) :
    j = i ∨ Ioi i = Ici j :=
  @lub_Iio_eq_self_or_Iio_eq_Iic γᵒᵈ _ j i hj
#align glb_Ioi_eq_self_or_Ioi_eq_Ici glb_Ioi_eq_self_or_Ioi_eq_Ici

section

variable [LinearOrder γ]

theorem exists_lub_Iio (i : γ) : ∃ j, IsLUB (Iio i) j := by
  by_cases h_exists_lt : ∃ j, j ∈ upperBounds (Iio i) ∧ j < i
  · obtain ⟨j, hj_ub, hj_lt_i⟩ := h_exists_lt
    exact ⟨j, hj_ub, fun k hk_ub => hk_ub hj_lt_i⟩
  · refine' ⟨i, fun j hj => le_of_lt hj, _⟩
    rw [mem_lowerBounds]
    by_contra h
    refine' h_exists_lt _
    push_neg at h
    exact h
#align exists_lub_Iio exists_lub_Iio

theorem exists_glb_Ioi (i : γ) : ∃ j, IsGLB (Ioi i) j :=
  @exists_lub_Iio γᵒᵈ _ i
#align exists_glb_Ioi exists_glb_Ioi

variable [DenselyOrdered γ]

theorem isLUB_Iio {a : γ} : IsLUB (Iio a) a :=
  ⟨fun _ hx => le_of_lt hx, fun _ hy => le_of_forall_ge_of_dense hy⟩
#align is_lub_Iio isLUB_Iio

theorem isGLB_Ioi {a : γ} : IsGLB (Ioi a) a :=
  @isLUB_Iio γᵒᵈ _ _ a
#align is_glb_Ioi isGLB_Ioi

theorem upperBounds_Iio {a : γ} : upperBounds (Iio a) = Ici a :=
  isLUB_Iio.upperBounds_eq
#align upper_bounds_Iio upperBounds_Iio

theorem lowerBounds_Ioi {a : γ} : lowerBounds (Ioi a) = Iic a :=
  isGLB_Ioi.lowerBounds_eq
#align lower_bounds_Ioi lowerBounds_Ioi

end

/-!
#### Singleton
-/

theorem isGreatest_singleton : IsGreatest {a} a :=
  ⟨mem_singleton a, fun _ hx => le_of_eq <| eq_of_mem_singleton hx⟩
#align is_greatest_singleton isGreatest_singleton

theorem isLeast_singleton : IsLeast {a} a :=
  @isGreatest_singleton αᵒᵈ _ a
#align is_least_singleton isLeast_singleton

theorem isLUB_singleton : IsLUB {a} a :=
  isGreatest_singleton.isLUB
#align is_lub_singleton isLUB_singleton

theorem isGLB_singleton : IsGLB {a} a :=
  isLeast_singleton.isGLB
#align is_glb_singleton isGLB_singleton

theorem bddAbove_singleton : BddAbove ({a} : Set α) :=
  isLUB_singleton.bddAbove
#align bdd_above_singleton bddAbove_singleton

theorem bddBelow_singleton : BddBelow ({a} : Set α) :=
  isGLB_singleton.bddBelow
#align bdd_below_singleton bddBelow_singleton

@[simp]
theorem upperBounds_singleton : upperBounds {a} = Ici a :=
  isLUB_singleton.upperBounds_eq
#align upper_bounds_singleton upperBounds_singleton

@[simp]
theorem lowerBounds_singleton : lowerBounds {a} = Iic a :=
  isGLB_singleton.lowerBounds_eq
#align lower_bounds_singleton lowerBounds_singleton

/-!
#### Bounded intervals
-/

theorem bddAbove_Icc : BddAbove (Icc a b) :=
  ⟨b, fun _ => And.right⟩
#align bdd_above_Icc bddAbove_Icc

theorem bddBelow_Icc : BddBelow (Icc a b) :=
  ⟨a, fun _ => And.left⟩
#align bdd_below_Icc bddBelow_Icc

theorem bddAbove_Ico : BddAbove (Ico a b) :=
  bddAbove_Icc.mono Ico_subset_Icc_self
#align bdd_above_Ico bddAbove_Ico

theorem bddBelow_Ico : BddBelow (Ico a b) :=
  bddBelow_Icc.mono Ico_subset_Icc_self
#align bdd_below_Ico bddBelow_Ico

theorem bddAbove_Ioc : BddAbove (Ioc a b) :=
  bddAbove_Icc.mono Ioc_subset_Icc_self
#align bdd_above_Ioc bddAbove_Ioc

theorem bddBelow_Ioc : BddBelow (Ioc a b) :=
  bddBelow_Icc.mono Ioc_subset_Icc_self
#align bdd_below_Ioc bddBelow_Ioc

theorem bddAbove_Ioo : BddAbove (Ioo a b) :=
  bddAbove_Icc.mono Ioo_subset_Icc_self
#align bdd_above_Ioo bddAbove_Ioo

theorem bddBelow_Ioo : BddBelow (Ioo a b) :=
  bddBelow_Icc.mono Ioo_subset_Icc_self
#align bdd_below_Ioo bddBelow_Ioo

theorem isGreatest_Icc (h : a ≤ b) : IsGreatest (Icc a b) b :=
  ⟨right_mem_Icc.2 h, fun _ => And.right⟩
#align is_greatest_Icc isGreatest_Icc

theorem isLUB_Icc (h : a ≤ b) : IsLUB (Icc a b) b :=
  (isGreatest_Icc h).isLUB
#align is_lub_Icc isLUB_Icc

theorem upperBounds_Icc (h : a ≤ b) : upperBounds (Icc a b) = Ici b :=
  (isLUB_Icc h).upperBounds_eq
#align upper_bounds_Icc upperBounds_Icc

theorem isLeast_Icc (h : a ≤ b) : IsLeast (Icc a b) a :=
  ⟨left_mem_Icc.2 h, fun _ => And.left⟩
#align is_least_Icc isLeast_Icc

theorem isGLB_Icc (h : a ≤ b) : IsGLB (Icc a b) a :=
  (isLeast_Icc h).isGLB
#align is_glb_Icc isGLB_Icc

theorem lowerBounds_Icc (h : a ≤ b) : lowerBounds (Icc a b) = Iic a :=
  (isGLB_Icc h).lowerBounds_eq
#align lower_bounds_Icc lowerBounds_Icc

theorem isGreatest_Ioc (h : a < b) : IsGreatest (Ioc a b) b :=
  ⟨right_mem_Ioc.2 h, fun _ => And.right⟩
#align is_greatest_Ioc isGreatest_Ioc

theorem isLUB_Ioc (h : a < b) : IsLUB (Ioc a b) b :=
  (isGreatest_Ioc h).isLUB
#align is_lub_Ioc isLUB_Ioc

theorem upperBounds_Ioc (h : a < b) : upperBounds (Ioc a b) = Ici b :=
  (isLUB_Ioc h).upperBounds_eq
#align upper_bounds_Ioc upperBounds_Ioc

theorem isLeast_Ico (h : a < b) : IsLeast (Ico a b) a :=
  ⟨left_mem_Ico.2 h, fun _ => And.left⟩
#align is_least_Ico isLeast_Ico

theorem isGLB_Ico (h : a < b) : IsGLB (Ico a b) a :=
  (isLeast_Ico h).isGLB
#align is_glb_Ico isGLB_Ico

theorem lowerBounds_Ico (h : a < b) : lowerBounds (Ico a b) = Iic a :=
  (isGLB_Ico h).lowerBounds_eq
#align lower_bounds_Ico lowerBounds_Ico

section

variable [SemilatticeSup γ] [DenselyOrdered γ]

theorem isGLB_Ioo {a b : γ} (h : a < b) : IsGLB (Ioo a b) a :=
  ⟨fun x hx => hx.1.le, fun x hx => by
    cases' eq_or_lt_of_le (le_sup_right : a ≤ x ⊔ a) with h₁ h₂
    · exact h₁.symm ▸ le_sup_left
    obtain ⟨y, lty, ylt⟩ := exists_between h₂
    apply (not_lt_of_le (sup_le (hx ⟨lty, ylt.trans_le (sup_le _ h.le)⟩) lty.le) ylt).elim
    obtain ⟨u, au, ub⟩ := exists_between h
    apply (hx ⟨au, ub⟩).trans ub.le⟩
#align is_glb_Ioo isGLB_Ioo

theorem lowerBounds_Ioo {a b : γ} (hab : a < b) : lowerBounds (Ioo a b) = Iic a :=
  (isGLB_Ioo hab).lowerBounds_eq
#align lower_bounds_Ioo lowerBounds_Ioo

theorem isGLB_Ioc {a b : γ} (hab : a < b) : IsGLB (Ioc a b) a :=
  (isGLB_Ioo hab).of_subset_of_superset (isGLB_Icc hab.le) Ioo_subset_Ioc_self Ioc_subset_Icc_self
#align is_glb_Ioc isGLB_Ioc

theorem lowerBounds_Ioc {a b : γ} (hab : a < b) : lowerBounds (Ioc a b) = Iic a :=
  (isGLB_Ioc hab).lowerBounds_eq
#align lower_bound_Ioc lowerBounds_Ioc

end

section

variable [SemilatticeInf γ] [DenselyOrdered γ]

theorem isLUB_Ioo {a b : γ} (hab : a < b) : IsLUB (Ioo a b) b := by
  simpa only [dual_Ioo] using isGLB_Ioo hab.dual
#align is_lub_Ioo isLUB_Ioo

theorem upperBounds_Ioo {a b : γ} (hab : a < b) : upperBounds (Ioo a b) = Ici b :=
  (isLUB_Ioo hab).upperBounds_eq
#align upper_bounds_Ioo upperBounds_Ioo

theorem isLUB_Ico {a b : γ} (hab : a < b) : IsLUB (Ico a b) b := by
  simpa only [dual_Ioc] using isGLB_Ioc hab.dual
#align is_lub_Ico isLUB_Ico

theorem upperBounds_Ico {a b : γ} (hab : a < b) : upperBounds (Ico a b) = Ici b :=
  (isLUB_Ico hab).upperBounds_eq
#align upper_bounds_Ico upperBounds_Ico

end

theorem bddBelow_iff_subset_Ici : BddBelow s ↔ ∃ a, s ⊆ Ici a :=
  Iff.rfl
#align bdd_below_iff_subset_Ici bddBelow_iff_subset_Ici

theorem bddAbove_iff_subset_Iic : BddAbove s ↔ ∃ a, s ⊆ Iic a :=
  Iff.rfl
#align bdd_above_iff_subset_Iic bddAbove_iff_subset_Iic

theorem bddBelow_bddAbove_iff_subset_Icc : BddBelow s ∧ BddAbove s ↔ ∃ a b, s ⊆ Icc a b := by
  simp [Ici_inter_Iic.symm, subset_inter_iff, bddBelow_iff_subset_Ici,
    bddAbove_iff_subset_Iic, exists_and_left, exists_and_right]
#align bdd_below_bdd_above_iff_subset_Icc bddBelow_bddAbove_iff_subset_Icc

/-!
#### Univ
-/

@[simp] theorem isGreatest_univ_iff : IsGreatest univ a ↔ IsTop a := by
  simp [IsGreatest, mem_upperBounds, IsTop]
#align is_greatest_univ_iff isGreatest_univ_iff

theorem isGreatest_univ [OrderTop α] : IsGreatest (univ : Set α) ⊤ :=
  isGreatest_univ_iff.2 isTop_top
#align is_greatest_univ isGreatest_univ

@[simp]
theorem OrderTop.upperBounds_univ [PartialOrder γ] [OrderTop γ] :
    upperBounds (univ : Set γ) = {⊤} := by rw [isGreatest_univ.upperBounds_eq, Ici_top]
#align order_top.upper_bounds_univ OrderTop.upperBounds_univ

theorem isLUB_univ [OrderTop α] : IsLUB (univ : Set α) ⊤ :=
  isGreatest_univ.isLUB
#align is_lub_univ isLUB_univ

@[simp]
theorem OrderBot.lowerBounds_univ [PartialOrder γ] [OrderBot γ] :
    lowerBounds (univ : Set γ) = {⊥} :=
  @OrderTop.upperBounds_univ γᵒᵈ _ _
#align order_bot.lower_bounds_univ OrderBot.lowerBounds_univ

@[simp] theorem isLeast_univ_iff : IsLeast univ a ↔ IsBot a :=
  @isGreatest_univ_iff αᵒᵈ _ _
#align is_least_univ_iff isLeast_univ_iff

theorem isLeast_univ [OrderBot α] : IsLeast (univ : Set α) ⊥ :=
  @isGreatest_univ αᵒᵈ _ _
#align is_least_univ isLeast_univ

theorem isGLB_univ [OrderBot α] : IsGLB (univ : Set α) ⊥ :=
  isLeast_univ.isGLB
#align is_glb_univ isGLB_univ

@[simp]
theorem NoMaxOrder.upperBounds_univ [NoMaxOrder α] : upperBounds (univ : Set α) = ∅ :=
  eq_empty_of_subset_empty fun b hb =>
    let ⟨_, hx⟩ := exists_gt b
    not_le_of_lt hx (hb trivial)
#align no_max_order.upper_bounds_univ NoMaxOrder.upperBounds_univ

@[simp]
theorem NoMinOrder.lowerBounds_univ [NoMinOrder α] : lowerBounds (univ : Set α) = ∅ :=
  @NoMaxOrder.upperBounds_univ αᵒᵈ _ _
#align no_min_order.lower_bounds_univ NoMinOrder.lowerBounds_univ

@[simp]
theorem not_bddAbove_univ [NoMaxOrder α] : ¬BddAbove (univ : Set α) := by simp [BddAbove]
#align not_bdd_above_univ not_bddAbove_univ

@[simp]
theorem not_bddBelow_univ [NoMinOrder α] : ¬BddBelow (univ : Set α) :=
  @not_bddAbove_univ αᵒᵈ _ _
#align not_bdd_below_univ not_bddBelow_univ

/-!
#### Empty set
-/

@[simp]
theorem upperBounds_empty : upperBounds (∅ : Set α) = univ := by
  simp only [upperBounds, eq_univ_iff_forall, mem_setOf_eq, ball_empty_iff, forall_true_iff]
#align upper_bounds_empty upperBounds_empty

@[simp]
theorem lowerBounds_empty : lowerBounds (∅ : Set α) = univ :=
  @upperBounds_empty αᵒᵈ _
#align lower_bounds_empty lowerBounds_empty

@[simp]
theorem bddAbove_empty [Nonempty α] : BddAbove (∅ : Set α) := by
  simp only [BddAbove, upperBounds_empty, univ_nonempty]
#align bdd_above_empty bddAbove_empty

@[simp]
theorem bddBelow_empty [Nonempty α] : BddBelow (∅ : Set α) := by
  simp only [BddBelow, lowerBounds_empty, univ_nonempty]
#align bdd_below_empty bddBelow_empty

@[simp] theorem isGLB_empty_iff : IsGLB ∅ a ↔ IsTop a := by
  simp [IsGLB]
#align is_glb_empty_iff isGLB_empty_iff

@[simp] theorem isLUB_empty_iff : IsLUB ∅ a ↔ IsBot a :=
  @isGLB_empty_iff αᵒᵈ _ _
#align is_lub_empty_iff isLUB_empty_iff

theorem isGLB_empty [OrderTop α] : IsGLB ∅ (⊤ : α) :=
  isGLB_empty_iff.2 isTop_top
#align is_glb_empty isGLB_empty

theorem isLUB_empty [OrderBot α] : IsLUB ∅ (⊥ : α) :=
  @isGLB_empty αᵒᵈ _ _
#align is_lub_empty isLUB_empty

theorem IsLUB.nonempty [NoMinOrder α] (hs : IsLUB s a) : s.Nonempty :=
  let ⟨a', ha'⟩ := exists_lt a
  nonempty_iff_ne_empty.2 fun h =>
    not_le_of_lt ha' <| hs.right <| by rw [h, upperBounds_empty]; exact mem_univ _
#align is_lub.nonempty IsLUB.nonempty

theorem IsGLB.nonempty [NoMaxOrder α] (hs : IsGLB s a) : s.Nonempty :=
  hs.dual.nonempty
#align is_glb.nonempty IsGLB.nonempty

theorem nonempty_of_not_bddAbove [ha : Nonempty α] (h : ¬BddAbove s) : s.Nonempty :=
  (Nonempty.elim ha) fun x => (not_bddAbove_iff'.1 h x).imp fun _ ha => ha.1
#align nonempty_of_not_bdd_above nonempty_of_not_bddAbove

theorem nonempty_of_not_bddBelow [Nonempty α] (h : ¬BddBelow s) : s.Nonempty :=
  @nonempty_of_not_bddAbove αᵒᵈ _ _ _ h
#align nonempty_of_not_bdd_below nonempty_of_not_bddBelow

/-!
#### insert
-/

/-- Adding a point to a set preserves its boundedness above. -/
@[simp]
theorem bddAbove_insert [SemilatticeSup γ] (a : γ) {s : Set γ} :
    BddAbove (insert a s) ↔ BddAbove s := by
  simp only [insert_eq, bddAbove_union, bddAbove_singleton, true_and_iff]
#align bdd_above_insert bddAbove_insert

theorem BddAbove.insert [SemilatticeSup γ] (a : γ) {s : Set γ} (hs : BddAbove s) :
    BddAbove (insert a s) :=
  (bddAbove_insert a).2 hs
#align bdd_above.insert BddAbove.insert

/-- Adding a point to a set preserves its boundedness below.-/
@[simp]
theorem bddBelow_insert [SemilatticeInf γ] (a : γ) {s : Set γ} :
    BddBelow (insert a s) ↔ BddBelow s := by
  simp only [insert_eq, bddBelow_union, bddBelow_singleton, true_and_iff]
#align bdd_below_insert bddBelow_insert

theorem BddBelow.insert [SemilatticeInf γ] (a : γ) {s : Set γ} (hs : BddBelow s) :
    BddBelow (insert a s) :=
  (bddBelow_insert a).2 hs
#align bdd_below.insert BddBelow.insert

theorem IsLUB.insert [SemilatticeSup γ] (a) {b} {s : Set γ} (hs : IsLUB s b) :
    IsLUB (insert a s) (a ⊔ b) := by
  rw [insert_eq]
  exact isLUB_singleton.union hs
#align is_lub.insert IsLUB.insert

theorem IsGLB.insert [SemilatticeInf γ] (a) {b} {s : Set γ} (hs : IsGLB s b) :
    IsGLB (insert a s) (a ⊓ b) := by
  rw [insert_eq]
  exact isGLB_singleton.union hs
#align is_glb.insert IsGLB.insert

theorem IsGreatest.insert [LinearOrder γ] (a) {b} {s : Set γ} (hs : IsGreatest s b) :
    IsGreatest (insert a s) (max a b) := by
  rw [insert_eq]
  exact isGreatest_singleton.union hs
#align is_greatest.insert IsGreatest.insert

theorem IsLeast.insert [LinearOrder γ] (a) {b} {s : Set γ} (hs : IsLeast s b) :
    IsLeast (insert a s) (min a b) := by
  rw [insert_eq]
  exact isLeast_singleton.union hs
#align is_least.insert IsLeast.insert

@[simp]
theorem upperBounds_insert (a : α) (s : Set α) :
    upperBounds (insert a s) = Ici a ∩ upperBounds s := by
  rw [insert_eq, upperBounds_union, upperBounds_singleton]
#align upper_bounds_insert upperBounds_insert

@[simp]
theorem lowerBounds_insert (a : α) (s : Set α) :
    lowerBounds (insert a s) = Iic a ∩ lowerBounds s := by
  rw [insert_eq, lowerBounds_union, lowerBounds_singleton]
#align lower_bounds_insert lowerBounds_insert

/-- When there is a global maximum, every set is bounded above. -/
@[simp]
protected theorem OrderTop.bddAbove [OrderTop α] (s : Set α) : BddAbove s :=
  ⟨⊤, fun a _ => OrderTop.le_top a⟩
#align order_top.bdd_above OrderTop.bddAbove

/-- When there is a global minimum, every set is bounded below. -/
@[simp]
protected theorem OrderBot.bddBelow [OrderBot α] (s : Set α) : BddBelow s :=
  ⟨⊥, fun a _ => OrderBot.bot_le a⟩
#align order_bot.bdd_below OrderBot.bddBelow

/-!
#### Pair
-/

theorem isLUB_pair [SemilatticeSup γ] {a b : γ} : IsLUB {a, b} (a ⊔ b) :=
  isLUB_singleton.insert _
#align is_lub_pair isLUB_pair

theorem isGLB_pair [SemilatticeInf γ] {a b : γ} : IsGLB {a, b} (a ⊓ b) :=
  isGLB_singleton.insert _
#align is_glb_pair isGLB_pair

theorem isLeast_pair [LinearOrder γ] {a b : γ} : IsLeast {a, b} (min a b) :=
  isLeast_singleton.insert _
#align is_least_pair isLeast_pair

theorem isGreatest_pair [LinearOrder γ] {a b : γ} : IsGreatest {a, b} (max a b) :=
  isGreatest_singleton.insert _
#align is_greatest_pair isGreatest_pair

/-!
#### Lower/upper bounds
-/

@[simp]
theorem isLUB_lowerBounds : IsLUB (lowerBounds s) a ↔ IsGLB s a :=
  ⟨fun H => ⟨fun _ hx => H.2 <| subset_upperBounds_lowerBounds s hx, H.1⟩, IsGreatest.isLUB⟩
#align is_lub_lower_bounds isLUB_lowerBounds

@[simp]
theorem isGLB_upperBounds : IsGLB (upperBounds s) a ↔ IsLUB s a :=
  @isLUB_lowerBounds αᵒᵈ _ _ _
#align is_glb_upper_bounds isGLB_upperBounds

end

/-!
### (In)equalities with the least upper bound and the greatest lower bound
-/

section Preorder

variable [Preorder α] {s : Set α} {a b : α}

theorem lowerBounds_le_upperBounds (ha : a ∈ lowerBounds s) (hb : b ∈ upperBounds s) :
    s.Nonempty → a ≤ b
  | ⟨_, hc⟩ => le_trans (ha hc) (hb hc)
#align lower_bounds_le_upper_bounds lowerBounds_le_upperBounds

theorem isGLB_le_isLUB (ha : IsGLB s a) (hb : IsLUB s b) (hs : s.Nonempty) : a ≤ b :=
  lowerBounds_le_upperBounds ha.1 hb.1 hs
#align is_glb_le_is_lub isGLB_le_isLUB

theorem isLUB_lt_iff (ha : IsLUB s a) : a < b ↔ ∃ c ∈ upperBounds s, c < b :=
  ⟨fun hb => ⟨a, ha.1, hb⟩, fun ⟨_, hcs, hcb⟩ => lt_of_le_of_lt (ha.2 hcs) hcb⟩
#align is_lub_lt_iff isLUB_lt_iff

theorem lt_isGLB_iff (ha : IsGLB s a) : b < a ↔ ∃ c ∈ lowerBounds s, b < c :=
  isLUB_lt_iff ha.dual
#align lt_is_glb_iff lt_isGLB_iff

theorem le_of_isLUB_le_isGLB {x y} (ha : IsGLB s a) (hb : IsLUB s b) (hab : b ≤ a) (hx : x ∈ s)
    (hy : y ∈ s) : x ≤ y :=
  calc
    x ≤ b := hb.1 hx
    _ ≤ a := hab
    _ ≤ y := ha.1 hy

#align le_of_is_lub_le_is_glb le_of_isLUB_le_isGLB

end Preorder

section PartialOrder

variable [PartialOrder α] {s : Set α} {a b : α}

theorem IsLeast.unique (Ha : IsLeast s a) (Hb : IsLeast s b) : a = b :=
  le_antisymm (Ha.right Hb.left) (Hb.right Ha.left)
#align is_least.unique IsLeast.unique

theorem IsLeast.isLeast_iff_eq (Ha : IsLeast s a) : IsLeast s b ↔ a = b :=
  Iff.intro Ha.unique fun h => h ▸ Ha
#align is_least.is_least_iff_eq IsLeast.isLeast_iff_eq

theorem IsGreatest.unique (Ha : IsGreatest s a) (Hb : IsGreatest s b) : a = b :=
  le_antisymm (Hb.right Ha.left) (Ha.right Hb.left)
#align is_greatest.unique IsGreatest.unique

theorem IsGreatest.isGreatest_iff_eq (Ha : IsGreatest s a) : IsGreatest s b ↔ a = b :=
  Iff.intro Ha.unique fun h => h ▸ Ha
#align is_greatest.is_greatest_iff_eq IsGreatest.isGreatest_iff_eq

theorem IsLUB.unique (Ha : IsLUB s a) (Hb : IsLUB s b) : a = b :=
  IsLeast.unique Ha Hb
#align is_lub.unique IsLUB.unique

theorem IsGLB.unique (Ha : IsGLB s a) (Hb : IsGLB s b) : a = b :=
  IsGreatest.unique Ha Hb
#align is_glb.unique IsGLB.unique

theorem Set.subsingleton_of_isLUB_le_isGLB (Ha : IsGLB s a) (Hb : IsLUB s b) (hab : b ≤ a) :
    s.Subsingleton := fun _ hx _ hy =>
  le_antisymm (le_of_isLUB_le_isGLB Ha Hb hab hx hy) (le_of_isLUB_le_isGLB Ha Hb hab hy hx)
#align set.subsingleton_of_is_lub_le_is_glb Set.subsingleton_of_isLUB_le_isGLB

theorem isGLB_lt_isLUB_of_ne (Ha : IsGLB s a) (Hb : IsLUB s b) {x y} (Hx : x ∈ s) (Hy : y ∈ s)
    (Hxy : x ≠ y) : a < b :=
  lt_iff_le_not_le.2
    ⟨lowerBounds_le_upperBounds Ha.1 Hb.1 ⟨x, Hx⟩, fun hab =>
      Hxy <| Set.subsingleton_of_isLUB_le_isGLB Ha Hb hab Hx Hy⟩
#align is_glb_lt_is_lub_of_ne isGLB_lt_isLUB_of_ne

end PartialOrder

section LinearOrder

variable [LinearOrder α] {s : Set α} {a b : α}

theorem lt_isLUB_iff (h : IsLUB s a) : b < a ↔ ∃ c ∈ s, b < c := by
  simp_rw [← not_le, isLUB_le_iff h, mem_upperBounds, not_forall, not_le, exists_prop]
#align lt_is_lub_iff lt_isLUB_iff

theorem isGLB_lt_iff (h : IsGLB s a) : a < b ↔ ∃ c ∈ s, c < b :=
  lt_isLUB_iff h.dual
#align is_glb_lt_iff isGLB_lt_iff

theorem IsLUB.exists_between (h : IsLUB s a) (hb : b < a) : ∃ c ∈ s, b < c ∧ c ≤ a :=
  let ⟨c, hcs, hbc⟩ := (lt_isLUB_iff h).1 hb
  ⟨c, hcs, hbc, h.1 hcs⟩
#align is_lub.exists_between IsLUB.exists_between

theorem IsLUB.exists_between' (h : IsLUB s a) (h' : a ∉ s) (hb : b < a) : ∃ c ∈ s, b < c ∧ c < a :=
  let ⟨c, hcs, hbc, hca⟩ := h.exists_between hb
  ⟨c, hcs, hbc, hca.lt_of_ne fun hac => h' <| hac ▸ hcs⟩
#align is_lub.exists_between' IsLUB.exists_between'

theorem IsGLB.exists_between (h : IsGLB s a) (hb : a < b) : ∃ c ∈ s, a ≤ c ∧ c < b :=
  let ⟨c, hcs, hbc⟩ := (isGLB_lt_iff h).1 hb
  ⟨c, hcs, h.1 hcs, hbc⟩
#align is_glb.exists_between IsGLB.exists_between

theorem IsGLB.exists_between' (h : IsGLB s a) (h' : a ∉ s) (hb : a < b) : ∃ c ∈ s, a < c ∧ c < b :=
  let ⟨c, hcs, hac, hcb⟩ := h.exists_between hb
  ⟨c, hcs, hac.lt_of_ne fun hac => h' <| hac.symm ▸ hcs, hcb⟩
#align is_glb.exists_between' IsGLB.exists_between'

end LinearOrder

/-!
### Images of upper/lower bounds under monotone functions
-/

namespace MonotoneOn

variable [Preorder α] [Preorder β] {f : α → β} {s t : Set α} (Hf : MonotoneOn f t) {a : α}
  (Hst : s ⊆ t)

theorem mem_upperBounds_image (Has : a ∈ upperBounds s) (Hat : a ∈ t) :
    f a ∈ upperBounds (f '' s) :=
  ball_image_of_ball fun _ H => Hf (Hst H) Hat (Has H)
#align monotone_on.mem_upper_bounds_image MonotoneOn.mem_upperBounds_image

theorem mem_upperBounds_image_self : a ∈ upperBounds t → a ∈ t → f a ∈ upperBounds (f '' t) :=
  Hf.mem_upperBounds_image subset_rfl
#align monotone_on.mem_upper_bounds_image_self MonotoneOn.mem_upperBounds_image_self

theorem mem_lowerBounds_image (Has : a ∈ lowerBounds s) (Hat : a ∈ t) :
    f a ∈ lowerBounds (f '' s) :=
  ball_image_of_ball fun _ H => Hf Hat (Hst H) (Has H)
#align monotone_on.mem_lower_bounds_image MonotoneOn.mem_lowerBounds_image

theorem mem_lowerBounds_image_self : a ∈ lowerBounds t → a ∈ t → f a ∈ lowerBounds (f '' t) :=
  Hf.mem_lowerBounds_image subset_rfl
#align monotone_on.mem_lower_bounds_image_self MonotoneOn.mem_lowerBounds_image_self

theorem image_upperBounds_subset_upperBounds_image (Hst : s ⊆ t) :
    f '' (upperBounds s ∩ t) ⊆ upperBounds (f '' s) := by
  rintro _ ⟨a, ha, rfl⟩
  exact Hf.mem_upperBounds_image Hst ha.1 ha.2
#align monotone_on.image_upper_bounds_subset_upper_bounds_image MonotoneOn.image_upperBounds_subset_upperBounds_image

theorem image_lowerBounds_subset_lowerBounds_image :
    f '' (lowerBounds s ∩ t) ⊆ lowerBounds (f '' s) :=
  Hf.dual.image_upperBounds_subset_upperBounds_image Hst
#align monotone_on.image_lower_bounds_subset_lower_bounds_image MonotoneOn.image_lowerBounds_subset_lowerBounds_image

/-- The image under a monotone function on a set `t` of a subset which has an upper bound in `t`
  is bounded above. -/
theorem map_bddAbove : (upperBounds s ∩ t).Nonempty → BddAbove (f '' s) := fun ⟨C, hs, ht⟩ =>
  ⟨f C, Hf.mem_upperBounds_image Hst hs ht⟩
#align monotone_on.map_bdd_above MonotoneOn.map_bddAbove

/-- The image under a monotone function on a set `t` of a subset which has a lower bound in `t`
  is bounded below. -/
theorem map_bddBelow : (lowerBounds s ∩ t).Nonempty → BddBelow (f '' s) := fun ⟨C, hs, ht⟩ =>
  ⟨f C, Hf.mem_lowerBounds_image Hst hs ht⟩
#align monotone_on.map_bdd_below MonotoneOn.map_bddBelow

/-- A monotone map sends a least element of a set to a least element of its image. -/
theorem map_isLeast (Ha : IsLeast t a) : IsLeast (f '' t) (f a) :=
  ⟨mem_image_of_mem _ Ha.1, Hf.mem_lowerBounds_image_self Ha.2 Ha.1⟩
#align monotone_on.map_is_least MonotoneOn.map_isLeast

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
theorem map_isGreatest (Ha : IsGreatest t a) : IsGreatest (f '' t) (f a) :=
  ⟨mem_image_of_mem _ Ha.1, Hf.mem_upperBounds_image_self Ha.2 Ha.1⟩
#align monotone_on.map_is_greatest MonotoneOn.map_isGreatest

end MonotoneOn

namespace AntitoneOn

variable [Preorder α] [Preorder β] {f : α → β} {s t : Set α} (Hf : AntitoneOn f t) {a : α}
  (Hst : s ⊆ t)

theorem mem_upperBounds_image (Has : a ∈ lowerBounds s) : a ∈ t → f a ∈ upperBounds (f '' s) :=
  Hf.dual_right.mem_lowerBounds_image Hst Has
#align antitone_on.mem_upper_bounds_image AntitoneOn.mem_upperBounds_image

theorem mem_upperBounds_image_self : a ∈ lowerBounds t → a ∈ t → f a ∈ upperBounds (f '' t) :=
  Hf.dual_right.mem_lowerBounds_image_self
#align antitone_on.mem_upper_bounds_image_self AntitoneOn.mem_upperBounds_image_self

theorem mem_lowerBounds_image : a ∈ upperBounds s → a ∈ t → f a ∈ lowerBounds (f '' s) :=
  Hf.dual_right.mem_upperBounds_image Hst
#align antitone_on.mem_lower_bounds_image AntitoneOn.mem_lowerBounds_image

theorem mem_lowerBounds_image_self : a ∈ upperBounds t → a ∈ t → f a ∈ lowerBounds (f '' t) :=
  Hf.dual_right.mem_upperBounds_image_self
#align antitone_on.mem_lower_bounds_image_self AntitoneOn.mem_lowerBounds_image_self

theorem image_lowerBounds_subset_upperBounds_image :
    f '' (lowerBounds s ∩ t) ⊆ upperBounds (f '' s) :=
  Hf.dual_right.image_lowerBounds_subset_lowerBounds_image Hst
#align antitone_on.image_lower_bounds_subset_upper_bounds_image AntitoneOn.image_lowerBounds_subset_upperBounds_image

theorem image_upperBounds_subset_lowerBounds_image :
    f '' (upperBounds s ∩ t) ⊆ lowerBounds (f '' s) :=
  Hf.dual_right.image_upperBounds_subset_upperBounds_image Hst
#align antitone_on.image_upper_bounds_subset_lower_bounds_image AntitoneOn.image_upperBounds_subset_lowerBounds_image

/-- The image under an antitone function of a set which is bounded above is bounded below. -/
theorem map_bddAbove : (upperBounds s ∩ t).Nonempty → BddBelow (f '' s) :=
  Hf.dual_right.map_bddAbove Hst
#align antitone_on.map_bdd_above AntitoneOn.map_bddAbove

/-- The image under an antitone function of a set which is bounded below is bounded above. -/
theorem map_bddBelow : (lowerBounds s ∩ t).Nonempty → BddAbove (f '' s) :=
  Hf.dual_right.map_bddBelow Hst
#align antitone_on.map_bdd_below AntitoneOn.map_bddBelow

/-- An antitone map sends a greatest element of a set to a least element of its image. -/
theorem map_isGreatest : IsGreatest t a → IsLeast (f '' t) (f a) :=
  Hf.dual_right.map_isGreatest
#align antitone_on.map_is_greatest AntitoneOn.map_isGreatest

/-- An antitone map sends a least element of a set to a greatest element of its image. -/
theorem map_isLeast : IsLeast t a → IsGreatest (f '' t) (f a) :=
  Hf.dual_right.map_isLeast
#align antitone_on.map_is_least AntitoneOn.map_isLeast

end AntitoneOn

namespace Monotone

variable [Preorder α] [Preorder β] {f : α → β} (Hf : Monotone f) {a : α} {s : Set α}

theorem mem_upperBounds_image (Ha : a ∈ upperBounds s) : f a ∈ upperBounds (f '' s) :=
  ball_image_of_ball fun _ H => Hf (Ha H)
#align monotone.mem_upper_bounds_image Monotone.mem_upperBounds_image

theorem mem_lowerBounds_image (Ha : a ∈ lowerBounds s) : f a ∈ lowerBounds (f '' s) :=
  ball_image_of_ball fun _ H => Hf (Ha H)
#align monotone.mem_lower_bounds_image Monotone.mem_lowerBounds_image

theorem image_upperBounds_subset_upperBounds_image : f '' upperBounds s ⊆ upperBounds (f '' s) := by
  rintro _ ⟨a, ha, rfl⟩
  exact Hf.mem_upperBounds_image ha
#align monotone.image_upper_bounds_subset_upper_bounds_image Monotone.image_upperBounds_subset_upperBounds_image

theorem image_lowerBounds_subset_lowerBounds_image : f '' lowerBounds s ⊆ lowerBounds (f '' s) :=
  Hf.dual.image_upperBounds_subset_upperBounds_image
#align monotone.image_lower_bounds_subset_lower_bounds_image Monotone.image_lowerBounds_subset_lowerBounds_image

/-- The image under a monotone function of a set which is bounded above is bounded above. See also
`bdd_above.image2`. -/
theorem map_bddAbove : BddAbove s → BddAbove (f '' s)
  | ⟨C, hC⟩ => ⟨f C, Hf.mem_upperBounds_image hC⟩
#align monotone.map_bdd_above Monotone.map_bddAbove

/-- The image under a monotone function of a set which is bounded below is bounded below. See also
`bdd_below.image2`. -/
theorem map_bddBelow : BddBelow s → BddBelow (f '' s)
  | ⟨C, hC⟩ => ⟨f C, Hf.mem_lowerBounds_image hC⟩
#align monotone.map_bdd_below Monotone.map_bddBelow

/-- A monotone map sends a least element of a set to a least element of its image. -/
theorem map_isLeast (Ha : IsLeast s a) : IsLeast (f '' s) (f a) :=
  ⟨mem_image_of_mem _ Ha.1, Hf.mem_lowerBounds_image Ha.2⟩
#align monotone.map_is_least Monotone.map_isLeast

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
theorem map_isGreatest (Ha : IsGreatest s a) : IsGreatest (f '' s) (f a) :=
  ⟨mem_image_of_mem _ Ha.1, Hf.mem_upperBounds_image Ha.2⟩
#align monotone.map_is_greatest Monotone.map_isGreatest

end Monotone

namespace Antitone

variable [Preorder α] [Preorder β] {f : α → β} (hf : Antitone f) {a : α} {s : Set α}

theorem mem_upperBounds_image : a ∈ lowerBounds s → f a ∈ upperBounds (f '' s) :=
  hf.dual_right.mem_lowerBounds_image
#align antitone.mem_upper_bounds_image Antitone.mem_upperBounds_image

theorem mem_lowerBounds_image : a ∈ upperBounds s → f a ∈ lowerBounds (f '' s) :=
  hf.dual_right.mem_upperBounds_image
#align antitone.mem_lower_bounds_image Antitone.mem_lowerBounds_image

theorem image_lowerBounds_subset_upperBounds_image : f '' lowerBounds s ⊆ upperBounds (f '' s) :=
  hf.dual_right.image_lowerBounds_subset_lowerBounds_image
#align antitone.image_lower_bounds_subset_upper_bounds_image Antitone.image_lowerBounds_subset_upperBounds_image

theorem image_upperBounds_subset_lowerBounds_image : f '' upperBounds s ⊆ lowerBounds (f '' s) :=
  hf.dual_right.image_upperBounds_subset_upperBounds_image
#align antitone.image_upper_bounds_subset_lower_bounds_image Antitone.image_upperBounds_subset_lowerBounds_image

/-- The image under an antitone function of a set which is bounded above is bounded below. -/
theorem map_bddAbove : BddAbove s → BddBelow (f '' s) :=
  hf.dual_right.map_bddAbove
#align antitone.map_bdd_above Antitone.map_bddAbove

/-- The image under an antitone function of a set which is bounded below is bounded above. -/
theorem map_bddBelow : BddBelow s → BddAbove (f '' s) :=
  hf.dual_right.map_bddBelow
#align antitone.map_bdd_below Antitone.map_bddBelow

/-- An antitone map sends a greatest element of a set to a least element of its image. -/
theorem map_isGreatest : IsGreatest s a → IsLeast (f '' s) (f a) :=
  hf.dual_right.map_isGreatest
#align antitone.map_is_greatest Antitone.map_isGreatest

/-- An antitone map sends a least element of a set to a greatest element of its image. -/
theorem map_isLeast : IsLeast s a → IsGreatest (f '' s) (f a) :=
  hf.dual_right.map_isLeast
#align antitone.map_is_least Antitone.map_isLeast

end Antitone

section Image2

variable [Preorder α] [Preorder β] [Preorder γ] {f : α → β → γ} {s : Set α} {t : Set β} {a : α}
  {b : β}

section MonotoneMonotone

variable (h₀ : ∀ b, Monotone (swap f b)) (h₁ : ∀ a, Monotone (f a))

theorem mem_upperBounds_image2 (ha : a ∈ upperBounds s) (hb : b ∈ upperBounds t) :
    f a b ∈ upperBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_upper_bounds_image2 mem_upperBounds_image2

theorem mem_lowerBounds_image2 (ha : a ∈ lowerBounds s) (hb : b ∈ lowerBounds t) :
    f a b ∈ lowerBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_lower_bounds_image2 mem_lowerBounds_image2

theorem image2_upperBounds_upperBounds_subset :
    image2 f (upperBounds s) (upperBounds t) ⊆ upperBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_upperBounds_image2 h₀ h₁ ha hb
#align image2_upper_bounds_upper_bounds_subset image2_upperBounds_upperBounds_subset

theorem image2_lowerBounds_lowerBounds_subset :
    image2 f (lowerBounds s) (lowerBounds t) ⊆ lowerBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_lowerBounds_image2 h₀ h₁ ha hb
#align image2_lower_bounds_lower_bounds_subset image2_lowerBounds_lowerBounds_subset

/-- See also `Monotone.map_bddAbove`. -/
theorem BddAbove.image2 : BddAbove s → BddAbove t → BddAbove (image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_upperBounds_image2 h₀ h₁ ha hb⟩
#align bdd_above.image2 BddAbove.image2

/-- See also `Monotone.map_bddBelow`. -/
theorem BddBelow.image2 : BddBelow s → BddBelow t → BddBelow (image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_lowerBounds_image2 h₀ h₁ ha hb⟩
#align bdd_below.image2 BddBelow.image2

theorem IsGreatest.image2 (ha : IsGreatest s a) (hb : IsGreatest t b) :
    IsGreatest (image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1, mem_upperBounds_image2 h₀ h₁ ha.2 hb.2⟩
#align is_greatest.image2 IsGreatest.image2

theorem IsLeast.image2 (ha : IsLeast s a) (hb : IsLeast t b) : IsLeast (image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1, mem_lowerBounds_image2 h₀ h₁ ha.2 hb.2⟩
#align is_least.image2 IsLeast.image2

end MonotoneMonotone

section MonotoneAntitone

variable (h₀ : ∀ b, Monotone (swap f b)) (h₁ : ∀ a, Antitone (f a))

theorem mem_upperBounds_image2_of_mem_upperBounds_of_mem_lowerBounds (ha : a ∈ upperBounds s)
    (hb : b ∈ lowerBounds t) : f a b ∈ upperBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds mem_upperBounds_image2_of_mem_upperBounds_of_mem_lowerBounds

theorem mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_upperBounds (ha : a ∈ lowerBounds s)
    (hb : b ∈ upperBounds t) : f a b ∈ lowerBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_upperBounds

theorem image2_upperBounds_lowerBounds_subset_upperBounds_image2 :
    image2 f (upperBounds s) (lowerBounds t) ⊆ upperBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_upperBounds_image2_of_mem_upperBounds_of_mem_lowerBounds h₀ h₁ ha hb
#align image2_upper_bounds_lower_bounds_subset_upper_bounds_image2 image2_upperBounds_lowerBounds_subset_upperBounds_image2

theorem image2_lowerBounds_upperBounds_subset_lowerBounds_image2 :
    image2 f (lowerBounds s) (upperBounds t) ⊆ lowerBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_upperBounds h₀ h₁ ha hb
#align image2_lower_bounds_upper_bounds_subset_lower_bounds_image2 image2_lowerBounds_upperBounds_subset_lowerBounds_image2

theorem BddAbove.bddAbove_image2_of_bddBelow :
    BddAbove s → BddBelow t → BddAbove (Set.image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_upperBounds_image2_of_mem_upperBounds_of_mem_lowerBounds h₀ h₁ ha hb⟩
#align bdd_above.bdd_above_image2_of_bdd_below BddAbove.bddAbove_image2_of_bddBelow

theorem BddBelow.bddBelow_image2_of_bddAbove :
    BddBelow s → BddAbove t → BddBelow (Set.image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_upperBounds h₀ h₁ ha hb⟩
#align bdd_below.bdd_below_image2_of_bdd_above BddBelow.bddBelow_image2_of_bddAbove

theorem IsGreatest.isGreatest_image2_of_isLeast (ha : IsGreatest s a) (hb : IsLeast t b) :
    IsGreatest (Set.image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1,
    mem_upperBounds_image2_of_mem_upperBounds_of_mem_lowerBounds h₀ h₁ ha.2 hb.2⟩
#align is_greatest.is_greatest_image2_of_is_least IsGreatest.isGreatest_image2_of_isLeast

theorem IsLeast.isLeast_image2_of_isGreatest (ha : IsLeast s a) (hb : IsGreatest t b) :
    IsLeast (Set.image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1,
    mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_upperBounds h₀ h₁ ha.2 hb.2⟩
#align is_least.is_least_image2_of_is_greatest IsLeast.isLeast_image2_of_isGreatest

end MonotoneAntitone

section AntitoneAntitone

variable (h₀ : ∀ b, Antitone (swap f b)) (h₁ : ∀ a, Antitone (f a))

theorem mem_upperBounds_image2_of_mem_lowerBounds (ha : a ∈ lowerBounds s)
    (hb : b ∈ lowerBounds t) : f a b ∈ upperBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_upper_bounds_image2_of_mem_lower_bounds mem_upperBounds_image2_of_mem_lowerBounds

theorem mem_lowerBounds_image2_of_mem_upperBounds (ha : a ∈ upperBounds s)
    (hb : b ∈ upperBounds t) : f a b ∈ lowerBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_lower_bounds_image2_of_mem_upper_bounds mem_lowerBounds_image2_of_mem_upperBounds

theorem image2_upperBounds_upperBounds_subset_upperBounds_image2 :
    image2 f (lowerBounds s) (lowerBounds t) ⊆ upperBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_upperBounds_image2_of_mem_lowerBounds h₀ h₁ ha hb
#align image2_upper_bounds_upper_bounds_subset_upper_bounds_image2 image2_upperBounds_upperBounds_subset_upperBounds_image2

theorem image2_lowerBounds_lowerBounds_subset_lowerBounds_image2 :
    image2 f (upperBounds s) (upperBounds t) ⊆ lowerBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_lowerBounds_image2_of_mem_upperBounds h₀ h₁ ha hb
#align image2_lower_bounds_lower_bounds_subset_lower_bounds_image2 image2_lowerBounds_lowerBounds_subset_lowerBounds_image2

theorem BddBelow.image2_bddAbove : BddBelow s → BddBelow t → BddAbove (Set.image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_upperBounds_image2_of_mem_lowerBounds h₀ h₁ ha hb⟩
#align bdd_below.image2_bdd_above BddBelow.image2_bddAbove

theorem BddAbove.image2_bddBelow : BddAbove s → BddAbove t → BddBelow (Set.image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_lowerBounds_image2_of_mem_upperBounds h₀ h₁ ha hb⟩
#align bdd_above.image2_bdd_below BddAbove.image2_bddBelow

theorem IsLeast.isGreatest_image2 (ha : IsLeast s a) (hb : IsLeast t b) :
    IsGreatest (Set.image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1, mem_upperBounds_image2_of_mem_lowerBounds h₀ h₁ ha.2 hb.2⟩
#align is_least.is_greatest_image2 IsLeast.isGreatest_image2

theorem IsGreatest.isLeast_image2 (ha : IsGreatest s a) (hb : IsGreatest t b) :
    IsLeast (Set.image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1, mem_lowerBounds_image2_of_mem_upperBounds h₀ h₁ ha.2 hb.2⟩
#align is_greatest.is_least_image2 IsGreatest.isLeast_image2

end AntitoneAntitone

section AntitoneMonotone

variable (h₀ : ∀ b, Antitone (swap f b)) (h₁ : ∀ a, Monotone (f a))

theorem mem_upperBounds_image2_of_mem_upperBounds_of_mem_upperBounds (ha : a ∈ lowerBounds s)
    (hb : b ∈ upperBounds t) : f a b ∈ upperBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds mem_upperBounds_image2_of_mem_upperBounds_of_mem_upperBounds

theorem mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_lowerBounds (ha : a ∈ upperBounds s)
    (hb : b ∈ lowerBounds t) : f a b ∈ lowerBounds (image2 f s t) :=
  forall_image2_iff.2 fun _ hx _ hy => (h₀ _ <| ha hx).trans <| h₁ _ <| hb hy
#align mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_lowerBounds

theorem image2_lowerBounds_upperBounds_subset_upperBounds_image2 :
    image2 f (lowerBounds s) (upperBounds t) ⊆ upperBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_upperBounds_image2_of_mem_upperBounds_of_mem_upperBounds h₀ h₁ ha hb
#align image2_lower_bounds_upper_bounds_subset_upper_bounds_image2 image2_lowerBounds_upperBounds_subset_upperBounds_image2

theorem image2_upperBounds_lowerBounds_subset_lowerBounds_image2 :
    image2 f (upperBounds s) (lowerBounds t) ⊆ lowerBounds (image2 f s t) := by
  rintro _ ⟨a, b, ha, hb, rfl⟩
  exact mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_lowerBounds h₀ h₁ ha hb
#align image2_upper_bounds_lower_bounds_subset_lower_bounds_image2 image2_upperBounds_lowerBounds_subset_lowerBounds_image2

theorem BddBelow.bddAbove_image2_of_bddAbove :
    BddBelow s → BddAbove t → BddAbove (Set.image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_upperBounds_image2_of_mem_upperBounds_of_mem_upperBounds h₀ h₁ ha hb⟩
#align bdd_below.bdd_above_image2_of_bdd_above BddBelow.bddAbove_image2_of_bddAbove

theorem BddAbove.bddBelow_image2_of_bddAbove :
    BddAbove s → BddBelow t → BddBelow (Set.image2 f s t) := by
  rintro ⟨a, ha⟩ ⟨b, hb⟩
  exact ⟨f a b, mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_lowerBounds h₀ h₁ ha hb⟩
#align bdd_above.bdd_below_image2_of_bdd_above BddAbove.bddBelow_image2_of_bddAbove

theorem IsLeast.isGreatest_image2_of_isGreatest (ha : IsLeast s a) (hb : IsGreatest t b) :
    IsGreatest (Set.image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1,
    mem_upperBounds_image2_of_mem_upperBounds_of_mem_upperBounds h₀ h₁ ha.2 hb.2⟩
#align is_least.is_greatest_image2_of_is_greatest IsLeast.isGreatest_image2_of_isGreatest

theorem IsGreatest.isLeast_image2_of_isLeast (ha : IsGreatest s a) (hb : IsLeast t b) :
    IsLeast (Set.image2 f s t) (f a b) :=
  ⟨mem_image2_of_mem ha.1 hb.1,
    mem_lowerBounds_image2_of_mem_lowerBounds_of_mem_lowerBounds h₀ h₁ ha.2 hb.2⟩
#align is_greatest.is_least_image2_of_is_least IsGreatest.isLeast_image2_of_isLeast

end AntitoneMonotone

end Image2

theorem IsGLB.of_image [Preorder α] [Preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
    {s : Set α} {x : α} (hx : IsGLB (f '' s) (f x)) : IsGLB s x :=
  ⟨fun _ hy => hf.1 <| hx.1 <| mem_image_of_mem _ hy, fun _ hy =>
    hf.1 <| hx.2 <| Monotone.mem_lowerBounds_image (fun _ _ => hf.2) hy⟩
#align is_glb.of_image IsGLB.of_image

theorem IsLUB.of_image [Preorder α] [Preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
    {s : Set α} {x : α} (hx : IsLUB (f '' s) (f x)) : IsLUB s x :=
  ⟨fun _ hy => hf.1 <| hx.1 <| mem_image_of_mem _ hy, fun _ hy =>
    hf.1 <| hx.2 <| Monotone.mem_upperBounds_image (fun _ _ => hf.2) hy⟩
#align is_lub.of_image IsLUB.of_image

theorem isLUB_pi {π : α → Type _} [∀ a, Preorder (π a)] {s : Set (∀ a, π a)} {f : ∀ a, π a} :
    IsLUB s f ↔ ∀ a, IsLUB (Function.eval a '' s) (f a) := by
  classical
    refine'
      ⟨fun H a => ⟨(Function.monotone_eval a).mem_upperBounds_image H.1, fun b hb => _⟩, fun H =>
        ⟨_, _⟩⟩
    · suffices h : Function.update f a b ∈ upperBounds s from Function.update_same a b f ▸ H.2 h a
      refine' fun g hg => le_update_iff.2 ⟨hb <| mem_image_of_mem _ hg, fun i _ => H.1 hg i⟩
    · exact fun g hg a => (H a).1 (mem_image_of_mem _ hg)
    · exact fun g hg a => (H a).2 ((Function.monotone_eval a).mem_upperBounds_image hg)
#align is_lub_pi isLUB_pi

theorem isGLB_pi {π : α → Type _} [∀ a, Preorder (π a)] {s : Set (∀ a, π a)} {f : ∀ a, π a} :
    IsGLB s f ↔ ∀ a, IsGLB (Function.eval a '' s) (f a) :=
  @isLUB_pi α (fun a => (π a)ᵒᵈ) _ s f
#align is_glb_pi isGLB_pi

theorem isLUB_prod [Preorder α] [Preorder β] {s : Set (α × β)} (p : α × β) :
    IsLUB s p ↔ IsLUB (Prod.fst '' s) p.1 ∧ IsLUB (Prod.snd '' s) p.2 := by
  refine'
    ⟨fun H =>
      ⟨⟨monotone_fst.mem_upperBounds_image H.1, fun a ha => _⟩,
        ⟨monotone_snd.mem_upperBounds_image H.1, fun a ha => _⟩⟩,
      fun H => ⟨_, _⟩⟩
  · suffices h : (a, p.2) ∈ upperBounds s from (H.2 h).1
    exact fun q hq => ⟨ha <| mem_image_of_mem _ hq, (H.1 hq).2⟩
  · suffices h : (p.1, a) ∈ upperBounds s from (H.2 h).2
    exact fun q hq => ⟨(H.1 hq).1, ha <| mem_image_of_mem _ hq⟩
  · exact fun q hq => ⟨H.1.1 <| mem_image_of_mem _ hq, H.2.1 <| mem_image_of_mem _ hq⟩
  ·
    exact fun q hq =>
      ⟨H.1.2 <| monotone_fst.mem_upperBounds_image hq,
        H.2.2 <| monotone_snd.mem_upperBounds_image hq⟩
#align is_lub_prod isLUB_prod

theorem isGLB_prod [Preorder α] [Preorder β] {s : Set (α × β)} (p : α × β) :
    IsGLB s p ↔ IsGLB (Prod.fst '' s) p.1 ∧ IsGLB (Prod.snd '' s) p.2 :=
  @isLUB_prod αᵒᵈ βᵒᵈ _ _ _ _
#align is_glb_prod isGLB_prod


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

! This file was ported from Lean 3 source module measure_theory.measure.doubling
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Log.Base
import Mathbin.MeasureTheory.Measure.MeasureSpaceDef

/-!
# Doubling measures

A doubling measure `μ` on a metric space is a measure for which there exists a constant `C` such
that for all sufficiently small radii `ε`, and for any centre, the measure of a ball of radius
`2 * ε` is bounded by `C` times the measure of the concentric ball of radius `ε`.

This file records basic files on doubling measures.

## Main definitions

  * `is_doubling_measure`: the definition of a doubling measure (as a typeclass).
  * `is_doubling_measure.doubling_constant`: a function yielding the doubling constant `C` appearing
  in the definition of a doubling measure.
-/

noncomputable section

open Set Filter Metric MeasureTheory TopologicalSpace

open ENNReal NNReal Topology

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`exists_measure_closedBall_le_mul] [] -/
/-- A measure `μ` is said to be a doubling measure if there exists a constant `C` such that for
all sufficiently small radii `ε`, and for any centre, the measure of a ball of radius `2 * ε` is
bounded by `C` times the measure of the concentric ball of radius `ε`.

Note: it is important that this definition makes a demand only for sufficiently small `ε`. For
example we want hyperbolic space to carry the instance `is_doubling_measure volume` but volumes grow
exponentially in hyperbolic space. To be really explicit, consider the hyperbolic plane of
curvature -1, the area of a disc of radius `ε` is `A(ε) = 2π(cosh(ε) - 1)` so `A(2ε)/A(ε) ~ exp(ε)`.
-/
class IsDoublingMeasure {α : Type _} [MetricSpace α] [MeasurableSpace α] (μ : Measure α) where
  exists_measure_closedBall_le_mul :
    ∃ C : ℝ≥0, ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closedBall x (2 * ε)) ≤ C * μ (closedBall x ε)
#align is_doubling_measure IsDoublingMeasure

namespace IsDoublingMeasure

variable {α : Type _} [MetricSpace α] [MeasurableSpace α] (μ : Measure α) [IsDoublingMeasure μ]

/-- A doubling constant for a doubling measure.

See also `is_doubling_measure.scaling_constant_of`. -/
def doublingConstant : ℝ≥0 :=
  Classical.choose <| exists_measure_closedBall_le_mul μ
#align is_doubling_measure.doubling_constant IsDoublingMeasure.doublingConstant

theorem exists_measure_closedBall_le_mul' :
    ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closedBall x (2 * ε)) ≤ doublingConstant μ * μ (closedBall x ε) :=
  Classical.choose_spec <| exists_measure_closedBall_le_mul μ
#align is_doubling_measure.exists_measure_closed_ball_le_mul' IsDoublingMeasure.exists_measure_closedBall_le_mul'

theorem exists_eventually_forall_measure_closedBall_le_mul (K : ℝ) :
    ∃ C : ℝ≥0,
      ∀ᶠ ε in 𝓝[>] 0, ∀ (x t) (ht : t ≤ K), μ (closedBall x (t * ε)) ≤ C * μ (closedBall x ε) :=
  by
  let C := doubling_constant μ
  have hμ :
    ∀ n : ℕ, ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closed_ball x (2 ^ n * ε)) ≤ ↑(C ^ n) * μ (closed_ball x ε) :=
    by
    intro n
    induction' n with n ih
    · simp
    replace ih := eventually_nhdsWithin_pos_mul_left (two_pos : 0 < (2 : ℝ)) ih
    refine' (ih.and (exists_measure_closed_ball_le_mul' μ)).mono fun ε hε x => _
    calc
      μ (closed_ball x (2 ^ (n + 1) * ε)) = μ (closed_ball x (2 ^ n * (2 * ε))) := by
        rw [pow_succ', mul_assoc]
      _ ≤ ↑(C ^ n) * μ (closed_ball x (2 * ε)) := (hε.1 x)
      _ ≤ ↑(C ^ n) * (C * μ (closed_ball x ε)) := (ENNReal.mul_left_mono (hε.2 x))
      _ = ↑(C ^ (n + 1)) * μ (closed_ball x ε) := by rw [← mul_assoc, pow_succ', ENNReal.coe_mul]

  rcases lt_or_le K 1 with (hK | hK)
  · refine' ⟨1, _⟩
    simp only [ENNReal.coe_one, one_mul]
    exact
      eventually_mem_nhds_within.mono fun ε hε x t ht =>
        measure_mono <| closed_ball_subset_closed_ball (by nlinarith [mem_Ioi.mp hε])
  · refine'
      ⟨C ^ ⌈Real.logb 2 K⌉₊,
        ((hμ ⌈Real.logb 2 K⌉₊).And eventually_mem_nhdsWithin).mono fun ε hε x t ht =>
          le_trans (measure_mono <| closed_ball_subset_closed_ball _) (hε.1 x)⟩
    refine' mul_le_mul_of_nonneg_right (ht.trans _) (mem_Ioi.mp hε.2).le
    conv_lhs => rw [← Real.rpow_logb two_pos (by norm_num) (by linarith : 0 < K)]
    rw [← Real.rpow_nat_cast]
    exact Real.rpow_le_rpow_of_exponent_le one_le_two (Nat.le_ceil (Real.logb 2 K))
#align is_doubling_measure.exists_eventually_forall_measure_closed_ball_le_mul IsDoublingMeasure.exists_eventually_forall_measure_closedBall_le_mul

/-- A variant of `is_doubling_measure.doubling_constant` which allows for scaling the radius by
values other than `2`. -/
def scalingConstantOf (K : ℝ) : ℝ≥0 :=
  max (Classical.choose <| exists_eventually_forall_measure_closedBall_le_mul μ K) 1
#align is_doubling_measure.scaling_constant_of IsDoublingMeasure.scalingConstantOf

@[simp]
theorem one_le_scalingConstantOf (K : ℝ) : 1 ≤ scalingConstantOf μ K :=
  le_max_of_le_right <| le_refl 1
#align is_doubling_measure.one_le_scaling_constant_of IsDoublingMeasure.one_le_scalingConstantOf

theorem eventually_measure_mul_le_scalingConstantOf_mul (K : ℝ) :
    ∃ R : ℝ,
      0 < R ∧
        ∀ (x t r) (ht : t ∈ Ioc 0 K) (hr : r ≤ R),
          μ (closedBall x (t * r)) ≤ scalingConstantOf μ K * μ (closedBall x r) :=
  by
  have h := Classical.choose_spec (exists_eventually_forall_measure_closed_ball_le_mul μ K)
  rcases mem_nhdsWithin_Ioi_iff_exists_Ioc_subset.1 h with ⟨R, Rpos, hR⟩
  refine' ⟨R, Rpos, fun x t r ht hr => _⟩
  rcases lt_trichotomy r 0 with (rneg | rfl | rpos)
  · have : t * r < 0 := mul_neg_of_pos_of_neg ht.1 rneg
    simp only [closed_ball_eq_empty.2 this, measure_empty, zero_le']
  · simp only [MulZeroClass.mul_zero, closed_ball_zero]
    refine' le_mul_of_one_le_of_le _ le_rfl
    apply ENNReal.one_le_coe_iff.2 (le_max_right _ _)
  · apply (hR ⟨rpos, hr⟩ x t ht.2).trans _
    exact mul_le_mul_right' (ENNReal.coe_le_coe.2 (le_max_left _ _)) _
#align is_doubling_measure.eventually_measure_mul_le_scaling_constant_of_mul IsDoublingMeasure.eventually_measure_mul_le_scalingConstantOf_mul

theorem eventually_measure_le_scaling_constant_mul (K : ℝ) :
    ∀ᶠ r in 𝓝[>] 0, ∀ x, μ (closedBall x (K * r)) ≤ scalingConstantOf μ K * μ (closedBall x r) :=
  by
  filter_upwards [Classical.choose_spec
      (exists_eventually_forall_measure_closed_ball_le_mul μ K)]with r hr x
  exact (hr x K le_rfl).trans (mul_le_mul_right' (ENNReal.coe_le_coe.2 (le_max_left _ _)) _)
#align is_doubling_measure.eventually_measure_le_scaling_constant_mul IsDoublingMeasure.eventually_measure_le_scaling_constant_mul

theorem eventually_measure_le_scaling_constant_mul' (K : ℝ) (hK : 0 < K) :
    ∀ᶠ r in 𝓝[>] 0, ∀ x, μ (closedBall x r) ≤ scalingConstantOf μ K⁻¹ * μ (closedBall x (K * r)) :=
  by
  convert eventually_nhdsWithin_pos_mul_left hK (eventually_measure_le_scaling_constant_mul μ K⁻¹)
  ext
  simp [inv_mul_cancel_left₀ hK.ne']
#align is_doubling_measure.eventually_measure_le_scaling_constant_mul' IsDoublingMeasure.eventually_measure_le_scaling_constant_mul'

/-- A scale below which the doubling measure `μ` satisfies good rescaling properties when one
multiplies the radius of balls by at most `K`, as stated
in `measure_mul_le_scaling_constant_of_mul`. -/
def scalingScaleOf (K : ℝ) : ℝ :=
  (eventually_measure_mul_le_scalingConstantOf_mul μ K).some
#align is_doubling_measure.scaling_scale_of IsDoublingMeasure.scalingScaleOf

theorem scalingScaleOf_pos (K : ℝ) : 0 < scalingScaleOf μ K :=
  (eventually_measure_mul_le_scalingConstantOf_mul μ K).choose_spec.1
#align is_doubling_measure.scaling_scale_of_pos IsDoublingMeasure.scalingScaleOf_pos

theorem measure_mul_le_scalingConstantOf_mul {K : ℝ} {x : α} {t r : ℝ} (ht : t ∈ Ioc 0 K)
    (hr : r ≤ scalingScaleOf μ K) :
    μ (closedBall x (t * r)) ≤ scalingConstantOf μ K * μ (closedBall x r) :=
  (eventually_measure_mul_le_scalingConstantOf_mul μ K).choose_spec.2 x t r ht hr
#align is_doubling_measure.measure_mul_le_scaling_constant_of_mul IsDoublingMeasure.measure_mul_le_scalingConstantOf_mul

end IsDoublingMeasure


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Mon.limits
import algebra.category.Group.preadditive
import category_theory.over
import category_theory.limits.concrete_category
import category_theory.limits.shapes.concrete_category
import group_theory.subgroup.basic

/-!
# The category of (commutative) (additive) groups has all limits

Further, these limits are preserved by the forgetful functor --- that is,
the underlying types are just the limits in the category of types.

-/

open category_theory
open category_theory.limits

universes v u

noncomputable theory

variables {J : Type v} [small_category J]

namespace Group

@[to_additive]
instance group_obj (F : J ⥤ Group.{max v u}) (j) :
  group ((F ⋙ forget Group).obj j) :=
by { change group (F.obj j), apply_instance }

/--
The flat sections of a functor into `Group` form a subgroup of all sections.
-/
@[to_additive
  "The flat sections of a functor into `AddGroup` form an additive subgroup of all sections."]
def sections_subgroup (F : J ⥤ Group) :
  subgroup (Π j, F.obj j) :=
{ carrier := (F ⋙ forget Group).sections,
  inv_mem' := λ a ah j j' f,
  begin
    simp only [forget_map_eq_coe, functor.comp_map, pi.inv_apply, monoid_hom.map_inv, inv_inj],
    dsimp [functor.sections] at ah,
    rw ah f,
  end,
  ..(Mon.sections_submonoid (F ⋙ forget₂ Group Mon)) }

@[to_additive]
instance limit_group (F : J ⥤ Group.{max v u}) :
  group (types.limit_cone (F ⋙ forget Group)).X :=
begin
  change group (sections_subgroup F),
  apply_instance,
end

/-- We show that the forgetful functor `Group ⥤ Mon` creates limits.

All we need to do is notice that the limit point has a `group` instance available, and then reuse
the existing limit. -/
@[to_additive "We show that the forgetful functor `AddGroup ⥤ AddMon` creates limits.

All we need to do is notice that the limit point has an `add_group` instance available, and then
reuse the existing limit."]
instance (F : J ⥤ Group.{max v u}) : creates_limit F (forget₂ Group.{max v u} Mon.{max v u}) :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone :=
  { X := Group.of (types.limit_cone (F ⋙ forget Group)).X,
    π :=
    { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ Group Mon.{max v u}),
      naturality' :=
        (Mon.has_limits.limit_cone (F ⋙ forget₂ Group Mon.{max v u})).π.naturality, } },
  valid_lift := by apply is_limit.unique_up_to_iso (Mon.has_limits.limit_cone_is_limit _) t,
  makes_limit := is_limit.of_faithful (forget₂ Group Mon.{max v u})
    (Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) })

/--
A choice of limit cone for a functor into `Group`.
(Generally, you'll just want to use `limit F`.)
-/
@[to_additive "A choice of limit cone for a functor into `Group`.
(Generally, you'll just want to use `limit F`.)"]
def limit_cone (F : J ⥤ Group.{max v u}) : cone F :=
lift_limit (limit.is_limit (F ⋙ (forget₂ Group Mon.{max v u})))

/--
The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)
-/
@[to_additive "The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)"]
def limit_cone_is_limit (F : J ⥤ Group.{max v u}) : is_limit (limit_cone F) :=
lifted_limit_is_limit _

/-- The category of groups has all limits. -/
@[to_additive "The category of additive groups has all limits."]
instance has_limits_of_size : has_limits_of_size.{v v} Group.{max v u} :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit_of_created F (forget₂ Group Mon.{max v u}) } }

@[to_additive]
instance has_limits : has_limits Group.{u} := Group.has_limits_of_size.{u u}

/-- The forgetful functor from groups to monoids preserves all limits.

This means the underlying monoid of a limit can be computed as a limit in the category of monoids.
-/
@[to_additive AddGroup.forget₂_AddMon_preserves_limits "The forgetful functor from additive groups
to additive monoids preserves all limits.

This means the underlying additive monoid of a limit can be computed as a limit in the category of
additive monoids."]
instance forget₂_Mon_preserves_limits_of_size :
  preserves_limits_of_size.{v v} (forget₂ Group Mon.{max v u}) :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ F, by apply_instance } }

@[to_additive]
instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ Group Mon.{u}) :=
Group.forget₂_Mon_preserves_limits_of_size.{u u}

/-- The forgetful functor from groups to types preserves all limits.

This means the underlying type of a limit can be computed as a limit in the category of types. -/
@[to_additive "The forgetful functor from additive groups to types preserves all limits.

This means the underlying type of a limit can be computed as a limit in the category of types."]
instance forget_preserves_limits_of_size :
  preserves_limits_of_size.{v v} (forget Group.{max v u}) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ Group Mon) (forget Mon) } }

@[to_additive]
instance forget_preserves_limits : preserves_limits (forget Group.{u}) :=
Group.forget_preserves_limits_of_size.{u u}

end Group

namespace CommGroup

@[to_additive]
instance comm_group_obj (F : J ⥤ CommGroup.{max v u}) (j) :
  comm_group ((F ⋙ forget CommGroup).obj j) :=
by { change comm_group (F.obj j), apply_instance }

@[to_additive]
instance limit_comm_group (F : J ⥤ CommGroup.{max v u}) :
  comm_group (types.limit_cone (F ⋙ forget CommGroup.{max v u})).X :=
@subgroup.to_comm_group (Π j, F.obj j) _
  (Group.sections_subgroup (F ⋙ forget₂ CommGroup Group.{max v u}))

/--
We show that the forgetful functor `CommGroup ⥤ Group` creates limits.

All we need to do is notice that the limit point has a `comm_group` instance available,
and then reuse the existing limit.
-/
@[to_additive]
instance (F : J ⥤ CommGroup.{max v u}) : creates_limit F (forget₂ CommGroup Group.{max v u}) :=
creates_limit_of_reflects_iso (λ c' t,
{ lifted_cone :=
  { X := CommGroup.of (types.limit_cone (F ⋙ forget CommGroup)).X,
    π :=
    { app := Mon.limit_π_monoid_hom
        (F ⋙ forget₂ CommGroup Group.{max v u} ⋙ forget₂ Group Mon.{max v u}),
      naturality' := (Mon.has_limits.limit_cone _).π.naturality, } },
  valid_lift := by apply is_limit.unique_up_to_iso (Group.limit_cone_is_limit _) t,
  makes_limit := is_limit.of_faithful (forget₂ _ Group.{max v u} ⋙ forget₂ _ Mon.{max v u})
    (by apply Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) })

/--
A choice of limit cone for a functor into `CommGroup`.
(Generally, you'll just want to use `limit F`.)
-/
@[to_additive "A choice of limit cone for a functor into `CommGroup`.
(Generally, you'll just want to use `limit F`.)"]
def limit_cone (F : J ⥤ CommGroup.{max v u}) : cone F :=
lift_limit (limit.is_limit (F ⋙ (forget₂ CommGroup Group.{max v u})))

/--
The chosen cone is a limit cone.
(Generally, you'll just want to use `limit.cone F`.)
-/
@[to_additive "The chosen cone is a limit cone.
(Generally, you'll just wantto use `limit.cone F`.)"]
def limit_cone_is_limit (F : J ⥤ CommGroup.{max v u}) : is_limit (limit_cone F) :=
lifted_limit_is_limit _

/-- The category of commutative groups has all limits. -/
@[to_additive "The category of additive commutative groups has all limits."]
instance has_limits_of_size : has_limits_of_size.{v v} CommGroup.{max v u} :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit_of_created F (forget₂ CommGroup Group.{max v u}) } }

@[to_additive]
instance has_limits : has_limits CommGroup.{u} := CommGroup.has_limits_of_size.{u u}

/--
The forgetful functor from commutative groups to groups preserves all limits.
(That is, the underlying group could have been computed instead as limits in the category
of groups.)
-/
@[to_additive AddCommGroup.forget₂_AddGroup_preserves_limits
"The forgetful functor from additive commutative groups to groups preserves all limits.
(That is, the underlying group could have been computed instead as limits in the category
of additive groups.)"]
instance forget₂_Group_preserves_limits_of_size :
  preserves_limits_of_size.{v v} (forget₂ CommGroup Group.{max v u}) :=
{ preserves_limits_of_shape := λ J 𝒥,
  { preserves_limit := λ F, by apply_instance } }

@[to_additive]
instance forget₂_Group_preserves_limits : preserves_limits (forget₂ CommGroup Group.{u}) :=
CommGroup.forget₂_Group_preserves_limits_of_size.{u u}

/--
An auxiliary declaration to speed up typechecking.
-/
@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits_aux
  "An auxiliary declaration to speed up typechecking."]
def forget₂_CommMon_preserves_limits_aux (F : J ⥤ CommGroup.{max v u}) :
  is_limit ((forget₂ CommGroup CommMon).map_cone (limit_cone F)) :=
CommMon.limit_cone_is_limit (F ⋙ forget₂ CommGroup CommMon)

/--
The forgetful functor from commutative groups to commutative monoids preserves all limits.
(That is, the underlying commutative monoids could have been computed instead as limits
in the category of commutative monoids.)
-/
@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits
"The forgetful functor from additive commutative groups to additive commutative monoids preserves
all limits. (That is, the underlying additive commutative monoids could have been computed instead
as limits in the category of additive commutative monoids.)"]
instance forget₂_CommMon_preserves_limits_of_size :
  preserves_limits_of_size.{v v} (forget₂ CommGroup CommMon.{max v u}) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone
    (limit_cone_is_limit F) (forget₂_CommMon_preserves_limits_aux F) } }

/--
The forgetful functor from commutative groups to types preserves all limits. (That is, the
underlying types could have been computed instead as limits in the category of types.)
-/
@[to_additive AddCommGroup.forget_preserves_limits
"The forgetful functor from additive commutative groups to types preserves all limits. (That is,
the underlying types could have been computed instead as limits in the category of types.)"]
instance forget_preserves_limits_of_size :
  preserves_limits_of_size.{v v} (forget CommGroup.{max v u}) :=
{ preserves_limits_of_shape := λ J 𝒥, by exactI
  { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommGroup Group) (forget Group) } }

-- Verify we can form limits indexed over smaller categories.
example (f : ℕ → AddCommGroup) : has_product f := by apply_instance

end CommGroup

namespace AddCommGroup

/--
The categorical kernel of a morphism in `AddCommGroup`
agrees with the usual group-theoretical kernel.
-/
def kernel_iso_ker {G H : AddCommGroup.{u}} (f : G ⟶ H) :
  kernel f ≅ AddCommGroup.of f.ker :=
{ hom :=
  { to_fun := λ g, ⟨kernel.ι f g,
    begin
      -- TODO where is this `has_coe_t_aux.coe` coming from? can we prevent it appearing?
      change (kernel.ι f) g ∈ f.ker,
      simp [add_monoid_hom.mem_ker],
    end⟩,
    map_zero' := by { ext, simp, },
    map_add' := λ g g', by { ext, simp, }, },
  inv := kernel.lift f (add_subgroup.subtype f.ker) (by tidy),
  hom_inv_id' := by { apply equalizer.hom_ext _, ext, simp, },
  inv_hom_id' :=
  begin
    apply AddCommGroup.ext,
    simp only [add_monoid_hom.coe_mk, coe_id, coe_comp],
    rintro ⟨x, mem⟩,
    simp,
  end, }.

@[simp]
lemma kernel_iso_ker_hom_comp_subtype {G H : AddCommGroup} (f : G ⟶ H) :
  (kernel_iso_ker f).hom ≫ add_subgroup.subtype f.ker = kernel.ι f :=
by ext; refl

@[simp]
lemma kernel_iso_ker_inv_comp_ι {G H : AddCommGroup} (f : G ⟶ H) :
  (kernel_iso_ker f).inv ≫ kernel.ι f = add_subgroup.subtype f.ker :=
begin
  ext,
  simp [kernel_iso_ker],
end

/--
The categorical kernel inclusion for `f : G ⟶ H`, as an object over `G`,
agrees with the `subtype` map.
-/
@[simps]
def kernel_iso_ker_over {G H : AddCommGroup.{u}} (f : G ⟶ H) :
  over.mk (kernel.ι f) ≅ @over.mk _ _ G (AddCommGroup.of f.ker) (add_subgroup.subtype f.ker) :=
over.iso_mk (kernel_iso_ker f) (by simp)

end AddCommGroup


--Proof: a -> a

theorem Ex001_1(a : Prop) : a -> a :=
assume H1 : a,
show a ,from H1

--using tactics
theorem Ex001_2(a : Prop) : a -> a :=
begin
  intro H,
  exact H
end


import .util

universe u
variable {R : Type u}

class st_order R extends has_lt R := -- strict total order
    (lt_irrefl : forall a : R, not (a < a))
    (lt_trans  : forall {a b c : R}, a < b -> b < c -> a < c)
    (ne_lt     : forall {a b : R}, a != b -> a < b \/ b < a)
    -- Bell 1.2, but we use it as an axiom for better structure
    (lt_far    : forall {a b : R}, a < b -> forall c : R, a < c \/ c < b)
attribute [trans] st_order.lt_trans -- allow use of transitivity in calc proofs

-- ordered field
class st_ordered_field R extends field R, st_order R :=
    (lt_zero_one        : (0: R) < 1)
    (lt_add_left        : forall {a b : R}, a < b -> forall c : R, c + a < c + b)
    (lt_mul_pos_left    : forall {a b c : R}, 0 < c -> a < b -> c * a < c * b)

-- lemmas & theorems regarding ordering
namespace st_order
    variable [st_order R]
    variables {a b c : R}

    -- intervals
    definition lt_interval [has_lt R] (a: R) (b: R) : set R := fun r: R, a < r /\ r < b
    definition le_interval [has_le R] (a: R) (b: R) : set R := fun r: R, a <= r /\ r <= b
    notation `[` a `...` b `]` := lt_interval a b
    notation `[[` a `...` b `]]` := le_interval a b

    -- non-strict total order
    instance has_le : has_le R := {
        le := fun x, fun y, not (y < x)
    }
    attribute [reducible] has_le.le

    lemma lt_ne : a < b -> a != b :=
        assume a_lt_b,
        assume bad_a_eq_b: a = b,
        st_order.lt_irrefl a (calc
            a   < b : a_lt_b
            ... = a : by rw bad_a_eq_b
        )

    lemma le_refl : a <= a := lt_irrefl a

    @[trans]
    lemma le_trans : a <= b -> b <= c -> a <= c :=
        assume a_le_b b_le_c,
        assume bad_c_lt_a,
        have bad_or: c < b \/ b < a, from (st_order.lt_far bad_c_lt_a b),
        or.elim bad_or b_le_c a_le_b

    @[trans]
    lemma le_lt_trans : a <= b -> b < c -> a < c :=
        assume le,
        assume lt,
        have a != c, from
            assume bad,
            have b < a, by {rw bad, assumption},
            le this,
        have a < c \/ c < a, from ne_lt this,
        have right_bad : not (c < a), from
            assume bad,
            have b < a, from lt_trans lt bad,
            le this,
        or.resolve_right this right_bad
end st_order

namespace st_ordered_field
    variable [st_ordered_field R]
    variables {a b c : R}

    lemma zero_one_far : 0 < a \/ a < 1 := st_order.lt_far (lt_zero_one R) a

    lemma lt_neg_flip : a < b -> -b < -a :=
        assume lt: a < b,
        calc
            -b  = -b + (-a + a) : by simp
            ... = (-b + -a) + a : by rw add_assoc
            ... < (-b + -a) + b : lt_add_left lt _
            ... = -a            : by simp

    lemma one_div_pos_of_pos : 0 < c -> 0 < 1 / c :=
        assume c_pos,
        have c_ne_zero : c != 0, from ne.symm (st_order.lt_ne c_pos),
        have 1 / c != 0, from one_div_ne_zero c_ne_zero,
        have disj: 1 / c < 0 \/ 0 < 1 / c, from st_order.ne_lt this,
        have left: 1 / c < 0 -> 0 < 1 / c, from
            assume one_div_c_neg,
            have (1: R) < 1, from (calc
                1   = c * (1 / c) : by rw mul_div_cancel' _ c_ne_zero
                ... < c * 0       : lt_mul_pos_left c_pos one_div_c_neg
                ... = 0           : mul_zero _
                ... < (1: R)      : (lt_zero_one R)
            ),
            absurd this (st_order.lt_irrefl 1),
        or.elim disj left (fun x, x)

    lemma le_add_left : a <= b -> c + a <= c + b :=
        assume a_le_b,
        assume almost_bad,
        have bad: b < a, from calc
            b   = -c + (c + b) : by simp
            ... < -c + (c + a) : lt_add_left almost_bad (-c)
            ... = a            : by simp,
        a_le_b bad

    lemma le_zero_one : (0: R) <= 1 :=
        assume bad : (1: R) < 0,
        st_order.lt_irrefl 0 (calc
            0   < 1 : lt_zero_one R
            ... < 0 : bad
        )

    lemma le_mul_pos_left : a <= b -> 0 <= c -> c * a <= c * b :=
        assume a_le_b,
        assume zero_le_c,
        assume bc_lt_ac,

        have c_ne_zero: c != 0, from
            assume bad: c = 0,
            have c * b = c * a, by simp [bad, mul_zero],
            absurd this (st_order.lt_ne bc_lt_ac),
        have c < 0 \/ 0 < c, from st_order.ne_lt c_ne_zero,

        have right : not (0 < c), from
            assume c_pos,
            have b < a, from (calc
                b   = (1 / c) * c * b   : by rw [one_div_mul_cancel c_ne_zero, one_mul]
                ... = (1 / c) * (c * b) : by simp [mul_assoc]
                ... < (1 / c) * (c * a) : lt_mul_pos_left (one_div_pos_of_pos c_pos) bc_lt_ac
                ... = (1 / c) * c * a   : by simp [mul_assoc]
                ... = a                 : by rw [one_div_mul_cancel c_ne_zero, one_mul]
            ),
            a_le_b this,
        or.elim this zero_le_c right

    lemma le_neg_flip : a <= b -> -b <= -a :=
        assume a_le_b,
        assume neg_a_lt_neg_b,
        have b < a, from (calc
            b   = -(-b) : by rw neg_neg
            ... < -(-a) : lt_neg_flip neg_a_lt_neg_b
            ... = a     : by rw neg_neg
        ),
        absurd this a_le_b
end st_ordered_field


import Std
open Std
open Lean

inductive BoolExpr where
  | var (name : String)
  | val (b : Bool)
  | or  (p q : BoolExpr)
  | not (p : BoolExpr)
  deriving Repr, BEq, DecidableEq

def BoolExpr.isValue : BoolExpr → Bool
  | val _ => true
  | _     => false

instance : Inhabited BoolExpr where
  default := BoolExpr.val false

namespace BoolExpr

deriving instance DecidableEq for BoolExpr

#eval decide (BoolExpr.val true = BoolExpr.val false)

#check (a b : BoolExpr) → Decidable (a = b)

abbrev Context := AssocList String Bool

def denote (ctx : Context) : BoolExpr → Bool
  | BoolExpr.or p q => denote ctx p || denote ctx q
  | BoolExpr.not p  => !denote ctx p
  | BoolExpr.val b => b
  | BoolExpr.var x => if let some b := ctx.find? x then b else false

def simplify : BoolExpr → BoolExpr
  | or p q => mkOr (simplify p) (simplify q)
  | not p  => mkNot (simplify p)
  | e      => e
where
  mkOr : BoolExpr → BoolExpr → BoolExpr
    | p, val true   => val true
    | p, val false  => p
    | val true, p   => val true
    | val false, p  => p
    | p, q          => or p q

  mkNot : BoolExpr → BoolExpr
    | val b => val (!b)
    | p     => not p

@[simp] theorem denote_not_Eq (ctx : Context) (p : BoolExpr) : denote ctx (not p) = !denote ctx p := rfl
@[simp] theorem denote_or_Eq (ctx : Context) (p q : BoolExpr) : denote ctx (or p q) = (denote ctx p || denote ctx q) := rfl
@[simp] theorem denote_val_Eq (ctx : Context) (b : Bool) : denote ctx (val b) = b := rfl

@[simp] theorem denote_mkNot_Eq (ctx : Context) (p : BoolExpr) : denote ctx (simplify.mkNot p) = denote ctx (not p) := by
  cases p <;> rfl
@[simp] theorem mkOr_p_true (p : BoolExpr) : simplify.mkOr p (val true) = val true := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl
@[simp] theorem mkOr_p_false (p : BoolExpr) : simplify.mkOr p (val false) = p := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl
@[simp] theorem mkOr_true_p (p : BoolExpr) : simplify.mkOr (val true) p = val true := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl
@[simp] theorem mkOr_false_p (p : BoolExpr) : simplify.mkOr (val false) p = p := by
  cases p with
  | val x => cases x <;> rfl
  | _     => rfl

@[simp] theorem denote_mkOr (ctx : Context) (p q : BoolExpr) : denote ctx (simplify.mkOr p q) = denote ctx (or p q) := by
  cases p with
  | val x => cases q with
    | val y => cases x <;> cases y <;> simp
    | _     => cases x <;> simp
  | _ => cases q with
    | val y => cases y <;> simp
    | _     => rfl

@[simp] theorem simplify_not (p : BoolExpr) : simplify (not p) = simplify.mkNot (simplify p) := rfl
@[simp] theorem simplify_or (p q : BoolExpr) : simplify (or p q) = simplify.mkOr (simplify p) (simplify q) := rfl

def denote_simplify_eq (ctx : Context) (b : BoolExpr) : denote ctx (simplify b) = denote ctx b :=
  by induction b with
  | or p q ih₁ ih₂ => simp [ih₁, ih₂]
  | not p ih       => simp [ih]
  | _              => rfl

syntax "`[BExpr|" term "]" : term

macro_rules
 | `(`[BExpr| true])     => `(val true)
 | `(`[BExpr| false])    => `(val false)
 | `(`[BExpr| $x:ident]) => `(var $(quote x.getId.toString))
 | `(`[BExpr| $p ∨ $q])  => `(or `[BExpr| $p] `[BExpr| $q])
 | `(`[BExpr| ¬ $p])     => `(not `[BExpr| $p])

#check `[BExpr| ¬ p ∨ q]

syntax entry := ident " ↦ " term:max
syntax entry,* "⊢" term : term

macro_rules
  | `( $[$xs:ident ↦ $vs:term],* ⊢ $p:term ) =>
    let xs := xs.map fun x => quote x.getId.toString
    `(denote (List.toAssocList [$[( $xs , $vs )],*]) `[BExpr| $p])

#check b ↦ true ⊢ b ∨ b
#eval  a ↦ false, b ↦ false ⊢ b ∨ a


import tactic --hide

universe u --hide

-- Level name : intro

/-

## The `intro` tactic.

If your goal is

```
⊢ P → Q
```

meaning we need to prove the `P` implies `Q` then the tactic <mark style ="background-color : #ebdef0 ">`intro hp,`</mark>
will take `P` as true with proof `hp` and add `hp : P` to the assumptions. In addition,
it turn your goal into `⊢ Q`.

In other words the state of the lemma becomes:

```
hp : P
⊢ Q
```

Lets look at an example that needs the `intro` tactic:

-/

/-Hint : Hint
Start with `intro p`.
-/

/-Hint : Tip
 `intros` can be used to introduce
more than one assumption at once. Don't forget
to name your hypotheses, e.g. `intros hp hq` if your goal is `P → Q → R`.
-/

/- Lemma : no-side-bar
If $P$ is a logical statement then $P\implies P$.
-/
lemma implies_self (P : Prop) : P → P :=
begin
  intro p,
  exact p,

end

/- Tactic : intro

## The `intro` tactic.

If your goal is to prove the implication

```
⊢ P → Q
```

then the tactic

`intro hP,`

will add `hp : P` as an assumption (i.e. `hp` is the proof of `P`) and turn your goal into `⊢ Q`.
In other words we get:

```
hP : P
⊢ Q
```

Tip : `intros` can be used to introduce
more than one assumption at once. Don't forget
to name your hypotheses, e.g. `intros hP hQ` if your goal is `P → Q → R`.

-/


-- 10.lean

def prefix_sum : ℕ → list ℕ → list ℕ
| sum []             := [sum]
| sum (head :: tail) := sum :: (prefix_sum (sum + head) tail)

def plus_list : list ℕ → list ℕ → list ℕ
| [] _ := []
| _ [] := []
| (h1 :: t1) (h2 :: t2) := (h1 + h2) :: (plus_list t1 t2)

lemma plus_list_nil_l : ∀l, plus_list [] l = [] :=
begin
    intro l,
    cases l;
    simp [plus_list]
end

lemma plus_list_nil_r : ∀l, plus_list l [] = [] :=
begin
    intro l,
    cases l;
    simp [plus_list]
end

lemma plus_list_prefix_sum_comm : ∀l1 l2: list ℕ, ∀n m: ℕ,
    prefix_sum (n + m) (plus_list l1 l2)
    = plus_list (prefix_sum n l1) (prefix_sum m l2) :=
begin
    intro l1,
    induction l1,
        intro l2,
        induction l2,
            intros n m,
            simp [plus_list, prefix_sum, plus_list_nil_l, plus_list_nil_r],
        intros n m,
        simp [plus_list, prefix_sum, plus_list_nil_l, plus_list_nil_r],
    intro l2,
    induction l2,
        intros n m,
        simp [plus_list, prefix_sum, plus_list_nil_l, plus_list_nil_r],
    intros n m,
    simp [plus_list, prefix_sum, plus_list_nil_l, plus_list_nil_r],
    have h : (l1_hd + (l2_hd + (n + m))) = (n + l1_hd) + (m + l2_hd) := by simp,
    rw h,
    simp [prefix_sum] at l2_ih,
    have l3 : prefix_sum ((l1_hd + n) + (l2_hd + m)) (plus_list l1_tl l2_tl)
        = plus_list (prefix_sum (l1_hd + n) l1_tl) (prefix_sum (l2_hd + m) l2_tl) := by
            apply l1_ih,
    have c1: n + l1_hd + (m + l2_hd) = l1_hd + n + (l2_hd + m) := by simp,
    rw c1,
    exact l3
end

example : ∀l1 l2: list ℕ, prefix_sum 0 (plus_list l1 l2)
            = plus_list (prefix_sum 0 l1) (prefix_sum 0 l2) :=
begin
    intros,
    apply plus_list_prefix_sum_comm l1 l2 0 0
end