/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.braided
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.category_theory.limits.shapes.terminal
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# The natural monoidal structure on any category with finite (co)products.

A category with a monoidal structure provided in this way is sometimes called a (co)cartesian category,
although this is also sometimes used to mean a finitely complete category.
(See <https://ncatlab.org/nlab/show/cartesian+category>.)

As this works with either products or coproducts,
and sometimes we want to think of a different monoidal structure entirely,
we don't set up either construct as an instance.

## Implementation
We had previously chosen to rely on `has_terminal` and `has_binary_products` instead of
`has_finite_products`, because we were later relying on the definitional form of the tensor product.
Now that `has_limit` has been refactored to be a `Prop`,
this issue is irrelevant and we could simplify the construction here.

See `category_theory.monoidal.of_chosen_finite_products` for a variant of this construction
which allows specifying a particular choice of terminal object and binary products.
-/

namespace category_theory

/-- A category with a terminal object and binary products has a natural monoidal structure. -/
def monoidal_of_has_finite_products (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] : monoidal_category C :=
  monoidal_category.mk (fun (X Y : C) => X ⨯ Y)
    (fun (_x _x_1 _x_2 _x_3 : C) (f : _x ⟶ _x_1) (g : _x_2 ⟶ _x_3) => limits.prod.map f g) (⊤_C)
    limits.prod.associator (fun (P : C) => limits.prod.left_unitor P)
    fun (P : C) => limits.prod.right_unitor P

/--
The monoidal structure coming from finite products is symmetric.
-/
@[simp] theorem symmetric_of_has_finite_products_to_braided_category_braiding (C : Type u)
    [category C] [limits.has_terminal C] [limits.has_binary_products C] (X : C) (Y : C) :
    β_ = limits.prod.braiding X Y :=
  Eq.refl β_

namespace monoidal_of_has_finite_products

@[simp] theorem tensor_obj (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] (X : C) (Y : C) : X ⊗ Y = (X ⨯ Y) :=
  rfl

@[simp] theorem tensor_hom (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : Y ⟶ Z) :
    f ⊗ g = limits.prod.map f g :=
  rfl

@[simp] theorem left_unitor_hom (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] (X : C) : iso.hom λ_ = limits.prod.snd :=
  rfl

@[simp] theorem left_unitor_inv (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] (X : C) :
    iso.inv λ_ = limits.prod.lift (limits.terminal.from X) 𝟙 :=
  rfl

@[simp] theorem right_unitor_hom (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] (X : C) : iso.hom ρ_ = limits.prod.fst :=
  rfl

-- We don't mark this as a simp lemma, even though in many particular

@[simp] theorem right_unitor_inv (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] (X : C) :
    iso.inv ρ_ = limits.prod.lift 𝟙 (limits.terminal.from X) :=
  rfl

-- categories the right hand side will simplify significantly further.

-- For now, we'll plan to create specialised simp lemmas in each particular category.

theorem associator_hom (C : Type u) [category C] [limits.has_terminal C]
    [limits.has_binary_products C] (X : C) (Y : C) (Z : C) :
    iso.hom α_ =
        limits.prod.lift (limits.prod.fst ≫ limits.prod.fst)
          (limits.prod.lift (limits.prod.fst ≫ limits.prod.snd) limits.prod.snd) :=
  rfl

end monoidal_of_has_finite_products

/-- A category with an initial object and binary coproducts has a natural monoidal structure. -/
def monoidal_of_has_finite_coproducts (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] : monoidal_category C :=
  monoidal_category.mk (fun (X Y : C) => X ⨿ Y)
    (fun (_x _x_1 _x_2 _x_3 : C) (f : _x ⟶ _x_1) (g : _x_2 ⟶ _x_3) => limits.coprod.map f g) (⊥_C)
    limits.coprod.associator limits.coprod.left_unitor limits.coprod.right_unitor

/--
The monoidal structure coming from finite coproducts is symmetric.
-/
def symmetric_of_has_finite_coproducts (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] : symmetric_category C :=
  symmetric_category.mk

namespace monoidal_of_has_finite_coproducts

@[simp] theorem tensor_obj (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] (X : C) (Y : C) : X ⊗ Y = (X ⨿ Y) :=
  rfl

@[simp] theorem tensor_hom (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ X) (g : Y ⟶ Z) :
    f ⊗ g = limits.coprod.map f g :=
  rfl

@[simp] theorem left_unitor_hom (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] (X : C) :
    iso.hom λ_ = limits.coprod.desc (limits.initial.to X) 𝟙 :=
  rfl

@[simp] theorem right_unitor_hom (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] (X : C) :
    iso.hom ρ_ = limits.coprod.desc 𝟙 (limits.initial.to X) :=
  rfl

@[simp] theorem left_unitor_inv (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] (X : C) : iso.inv λ_ = limits.coprod.inr :=
  rfl

-- We don't mark this as a simp lemma, even though in many particular

@[simp] theorem right_unitor_inv (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] (X : C) : iso.inv ρ_ = limits.coprod.inl :=
  rfl

-- categories the right hand side will simplify significantly further.

-- For now, we'll plan to create specialised simp lemmas in each particular category.

theorem associator_hom (C : Type u) [category C] [limits.has_initial C]
    [limits.has_binary_coproducts C] (X : C) (Y : C) (Z : C) :
    iso.hom α_ =
        limits.coprod.desc
          (limits.coprod.desc limits.coprod.inl (limits.coprod.inl ≫ limits.coprod.inr))
          (limits.coprod.inr ≫ limits.coprod.inr) :=
  rfl

end Mathlib


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pfun
import Mathlib.tactic.norm_num
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

namespace Mathlib

/-!
# Natural numbers with infinity

The natural numbers and an extra `top` element `⊤`.

## Main definitions

The following instances are defined:

* `ordered_add_comm_monoid enat`
* `canonically_ordered_add_monoid enat`

There is no additive analogue of `monoid_with_zero`; if there were then `enat` could
be an `add_monoid_with_top`.

* `to_with_top` : the map from `enat` to `with_top ℕ`, with theorems that it plays well
with `+` and `≤`.

* `with_top_add_equiv : enat ≃+ with_top ℕ`
* `with_top_order_iso : enat ≃o with_top ℕ`

## Implementation details

`enat` is defined to be `roption ℕ`.

`+` and `≤` are defined on `enat`, but there is an issue with `*` because it's not
clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous
so there is no `-` defined on `enat`.

Before the `open_locale classical` line, various proofs are made with decidability assumptions.
This can cause issues -- see for example the non-simp lemma `to_with_top_zero` proved by `rfl`,
followed by `@[simp] lemma to_with_top_zero'` whose proof uses `convert`.

## Tags

enat, with_top ℕ
-/

/-- Type of natural numbers with infinity (`⊤`) -/
def enat :=
  roption ℕ

namespace enat

protected instance has_zero : HasZero enat :=
  { zero := roption.some 0 }

protected instance inhabited : Inhabited enat :=
  { default := 0 }

protected instance has_one : HasOne enat :=
  { one := roption.some 1 }

protected instance has_add : Add enat :=
  { add :=
      fun (x y : enat) =>
        roption.mk (roption.dom x ∧ roption.dom y)
          fun (h : roption.dom x ∧ roption.dom y) => roption.get x sorry + roption.get y sorry }

protected instance has_coe : has_coe ℕ enat :=
  has_coe.mk roption.some

protected instance dom.decidable (n : ℕ) : Decidable (roption.dom ↑n) :=
  is_true trivial

@[simp] theorem coe_inj {x : ℕ} {y : ℕ} : ↑x = ↑y ↔ x = y :=
  roption.some_inj

@[simp] theorem dom_coe (x : ℕ) : roption.dom ↑x :=
  trivial

protected instance add_comm_monoid : add_comm_monoid enat :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance has_le : HasLessEq enat :=
  { LessEq :=
      fun (x y : enat) =>
        ∃ (h : roption.dom y → roption.dom x), ∀ (hy : roption.dom y), roption.get x (h hy) ≤ roption.get y hy }

protected instance has_top : has_top enat :=
  has_top.mk roption.none

protected instance has_bot : has_bot enat :=
  has_bot.mk 0

protected instance has_sup : has_sup enat :=
  has_sup.mk
    fun (x y : enat) =>
      roption.mk (roption.dom x ∧ roption.dom y)
        fun (h : roption.dom x ∧ roption.dom y) => roption.get x sorry ⊔ roption.get y sorry

theorem le_def (x : enat) (y : enat) : x ≤ y ↔ ∃ (h : roption.dom y → roption.dom x), ∀ (hy : roption.dom y), roption.get x (h hy) ≤ roption.get y hy :=
  iff.rfl

protected theorem cases_on {P : enat → Prop} (a : enat) : P ⊤ → (∀ (n : ℕ), P ↑n) → P a :=
  roption.induction_on

@[simp] theorem top_add (x : enat) : ⊤ + x = ⊤ :=
  roption.ext' (false_and (roption.dom x)) fun (h : roption.dom (⊤ + x)) => false.elim (and.left h)

@[simp] theorem add_top (x : enat) : x + ⊤ = ⊤ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x + ⊤ = ⊤)) (add_comm x ⊤)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (⊤ + x = ⊤)) (top_add x))) (Eq.refl ⊤))

@[simp] theorem coe_zero : ↑0 = 0 :=
  rfl

@[simp] theorem coe_one : ↑1 = 1 :=
  rfl

@[simp] theorem coe_add (x : ℕ) (y : ℕ) : ↑(x + y) = ↑x + ↑y :=
  roption.ext' (iff.symm (and_true (roption.dom ↑(x + y))))
    fun (_x : roption.dom ↑(x + y)) (_x_1 : roption.dom (↑x + ↑y)) => rfl

theorem get_coe {x : ℕ} : roption.get (↑x) True.intro = x :=
  rfl

@[simp] theorem get_coe' (x : ℕ) (h : roption.dom ↑x) : roption.get (↑x) h = x :=
  rfl

theorem coe_add_get {x : ℕ} {y : enat} (h : roption.dom (↑x + y)) : roption.get (↑x + y) h = x + roption.get y (and.right h) :=
  rfl

@[simp] theorem get_add {x : enat} {y : enat} (h : roption.dom (x + y)) : roption.get (x + y) h = roption.get x (and.left h) + roption.get y (and.right h) :=
  rfl

@[simp] theorem coe_get {x : enat} (h : roption.dom x) : ↑(roption.get x h) = x :=
  roption.ext' (iff_of_true trivial h) fun (_x : roption.dom ↑(roption.get x h)) (_x_1 : roption.dom x) => rfl

@[simp] theorem get_zero (h : roption.dom 0) : roption.get 0 h = 0 :=
  rfl

@[simp] theorem get_one (h : roption.dom 1) : roption.get 1 h = 1 :=
  rfl

theorem dom_of_le_of_dom {x : enat} {y : enat} : x ≤ y → roption.dom y → roption.dom x := sorry

theorem dom_of_le_some {x : enat} {y : ℕ} (h : x ≤ ↑y) : roption.dom x :=
  dom_of_le_of_dom h trivial

protected instance decidable_le (x : enat) (y : enat) [Decidable (roption.dom x)] [Decidable (roption.dom y)] : Decidable (x ≤ y) :=
  dite (roption.dom x)
    (fun (hx : roption.dom x) =>
      decidable_of_decidable_of_iff
        ((fun (this : Decidable (∀ (hy : roption.dom y), roption.get x hx ≤ roption.get y hy)) => this)
          (Mathlib.forall_prop_decidable fun (hy : roption.dom y) => roption.get x hx ≤ roption.get y hy))
        sorry)
    fun (hx : ¬roption.dom x) =>
      dite (roption.dom y) (fun (hy : roption.dom y) => isFalse sorry) fun (hy : ¬roption.dom y) => is_true sorry

/-- The coercion `ℕ → enat` preserves `0` and addition. -/
def coe_hom : ℕ →+ enat :=
  add_monoid_hom.mk coe coe_zero coe_add

protected instance partial_order : partial_order enat :=
  partial_order.mk LessEq (preorder.lt._default LessEq) sorry sorry sorry

theorem lt_def (x : enat) (y : enat) : x < y ↔ ∃ (hx : roption.dom x), ∀ (hy : roption.dom y), roption.get x hx < roption.get y hy := sorry

@[simp] theorem coe_le_coe {x : ℕ} {y : ℕ} : ↑x ≤ ↑y ↔ x ≤ y := sorry

@[simp] theorem coe_lt_coe {x : ℕ} {y : ℕ} : ↑x < ↑y ↔ x < y := sorry

@[simp] theorem get_le_get {x : enat} {y : enat} {hx : roption.dom x} {hy : roption.dom y} : roption.get x hx ≤ roption.get y hy ↔ x ≤ y := sorry

theorem le_coe_iff (x : enat) (n : ℕ) : x ≤ ↑n ↔ ∃ (h : roption.dom x), roption.get x h ≤ n := sorry

theorem lt_coe_iff (x : enat) (n : ℕ) : x < ↑n ↔ ∃ (h : roption.dom x), roption.get x h < n := sorry

theorem coe_le_iff (n : ℕ) (x : enat) : ↑n ≤ x ↔ ∀ (h : roption.dom x), n ≤ roption.get x h := sorry

theorem coe_lt_iff (n : ℕ) (x : enat) : ↑n < x ↔ ∀ (h : roption.dom x), n < roption.get x h := sorry

protected theorem zero_lt_one : 0 < 1 := sorry

protected instance semilattice_sup_bot : semilattice_sup_bot enat :=
  semilattice_sup_bot.mk ⊥ partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans
    partial_order.le_antisymm sorry has_sup.sup sorry sorry sorry

protected instance order_top : order_top enat :=
  order_top.mk ⊤ semilattice_sup_bot.le semilattice_sup_bot.lt semilattice_sup_bot.le_refl semilattice_sup_bot.le_trans
    semilattice_sup_bot.le_antisymm sorry

theorem dom_of_lt {x : enat} {y : enat} : x < y → roption.dom x :=
  enat.cases_on x not_top_lt fun (_x : ℕ) (_x : ↑_x < y) => trivial

theorem top_eq_none : ⊤ = roption.none :=
  rfl

@[simp] theorem coe_lt_top (x : ℕ) : ↑x < ⊤ :=
  lt_of_le_of_ne le_top fun (h : ↑x = ⊤) => absurd (congr_arg roption.dom h) true_ne_false

@[simp] theorem coe_ne_top (x : ℕ) : ↑x ≠ ⊤ :=
  ne_of_lt (coe_lt_top x)

theorem ne_top_iff {x : enat} : x ≠ ⊤ ↔ ∃ (n : ℕ), x = ↑n :=
  roption.ne_none_iff

theorem ne_top_iff_dom {x : enat} : x ≠ ⊤ ↔ roption.dom x :=
  iff.mp not_iff_comm (iff.symm roption.eq_none_iff')

theorem ne_top_of_lt {x : enat} {y : enat} (h : x < y) : x ≠ ⊤ :=
  ne_of_lt (lt_of_lt_of_le h le_top)

theorem eq_top_iff_forall_lt (x : enat) : x = ⊤ ↔ ∀ (n : ℕ), ↑n < x := sorry

theorem eq_top_iff_forall_le (x : enat) : x = ⊤ ↔ ∀ (n : ℕ), ↑n ≤ x :=
  iff.trans (eq_top_iff_forall_lt x)
    { mp := fun (h : ∀ (n : ℕ), ↑n < x) (n : ℕ) => has_lt.lt.le (h n),
      mpr := fun (h : ∀ (n : ℕ), ↑n ≤ x) (n : ℕ) => lt_of_lt_of_le (iff.mpr coe_lt_coe (nat.lt_succ_self n)) (h (n + 1)) }

theorem pos_iff_one_le {x : enat} : 0 < x ↔ 1 ≤ x := sorry

protected instance linear_order : linear_order enat :=
  linear_order.mk partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans partial_order.le_antisymm
    sorry (classical.dec_rel LessEq) Mathlib.decidable_eq_of_decidable_le Mathlib.decidable_lt_of_decidable_le

protected instance bounded_lattice : bounded_lattice enat :=
  bounded_lattice.mk semilattice_sup_bot.sup order_top.le order_top.lt order_top.le_refl order_top.le_trans
    order_top.le_antisymm semilattice_sup_bot.le_sup_left semilattice_sup_bot.le_sup_right semilattice_sup_bot.sup_le min
    min_le_left min_le_right sorry order_top.top order_top.le_top semilattice_sup_bot.bot semilattice_sup_bot.bot_le

theorem sup_eq_max {a : enat} {b : enat} : a ⊔ b = max a b :=
  le_antisymm (sup_le (le_max_left a b) (le_max_right a b)) (max_le le_sup_left le_sup_right)

theorem inf_eq_min {a : enat} {b : enat} : a ⊓ b = min a b :=
  rfl

protected instance ordered_add_comm_monoid : ordered_add_comm_monoid enat :=
  ordered_add_comm_monoid.mk add_comm_monoid.add add_comm_monoid.add_assoc add_comm_monoid.zero add_comm_monoid.zero_add
    add_comm_monoid.add_zero add_comm_monoid.add_comm linear_order.le linear_order.lt linear_order.le_refl
    linear_order.le_trans linear_order.le_antisymm sorry sorry

protected instance canonically_ordered_add_monoid : canonically_ordered_add_monoid enat :=
  canonically_ordered_add_monoid.mk ordered_add_comm_monoid.add ordered_add_comm_monoid.add_assoc
    ordered_add_comm_monoid.zero ordered_add_comm_monoid.zero_add ordered_add_comm_monoid.add_zero
    ordered_add_comm_monoid.add_comm semilattice_sup_bot.le semilattice_sup_bot.lt semilattice_sup_bot.le_refl
    semilattice_sup_bot.le_trans semilattice_sup_bot.le_antisymm ordered_add_comm_monoid.add_le_add_left
    ordered_add_comm_monoid.lt_of_add_lt_add_left semilattice_sup_bot.bot semilattice_sup_bot.bot_le sorry

protected theorem add_lt_add_right {x : enat} {y : enat} {z : enat} (h : x < y) (hz : z ≠ ⊤) : x + z < y + z := sorry

protected theorem add_lt_add_iff_right {x : enat} {y : enat} {z : enat} (hz : z ≠ ⊤) : x + z < y + z ↔ x < y :=
  { mp := lt_of_add_lt_add_right, mpr := fun (h : x < y) => enat.add_lt_add_right h hz }

protected theorem add_lt_add_iff_left {x : enat} {y : enat} {z : enat} (hz : z ≠ ⊤) : z + x < z + y ↔ x < y := sorry

protected theorem lt_add_iff_pos_right {x : enat} {y : enat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y := sorry

theorem lt_add_one {x : enat} (hx : x ≠ ⊤) : x < x + 1 := sorry

theorem le_of_lt_add_one {x : enat} {y : enat} (h : x < y + 1) : x ≤ y := sorry

theorem add_one_le_of_lt {x : enat} {y : enat} (h : x < y) : x + 1 ≤ y := sorry

theorem add_one_le_iff_lt {x : enat} {y : enat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y := sorry

theorem lt_add_one_iff_lt {x : enat} {y : enat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y := sorry

theorem add_eq_top_iff {a : enat} {b : enat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := sorry

protected theorem add_right_cancel_iff {a : enat} {b : enat} {c : enat} (hc : c ≠ ⊤) : a + c = b + c ↔ a = b := sorry

protected theorem add_left_cancel_iff {a : enat} {b : enat} {c : enat} (ha : a ≠ ⊤) : a + b = a + c ↔ b = c := sorry

/-- Computably converts an `enat` to a `with_top ℕ`. -/
def to_with_top (x : enat) [Decidable (roption.dom x)] : with_top ℕ :=
  roption.to_option x

theorem to_with_top_top : to_with_top ⊤ = ⊤ :=
  rfl

@[simp] theorem to_with_top_top' {h : Decidable (roption.dom ⊤)} : to_with_top ⊤ = ⊤ := sorry

theorem to_with_top_zero : to_with_top 0 = 0 :=
  rfl

@[simp] theorem to_with_top_zero' {h : Decidable (roption.dom 0)} : to_with_top 0 = 0 := sorry

theorem to_with_top_coe (n : ℕ) : to_with_top ↑n = ↑n :=
  rfl

@[simp] theorem to_with_top_coe' (n : ℕ) {h : Decidable (roption.dom ↑n)} : to_with_top ↑n = ↑n := sorry

@[simp] theorem to_with_top_le {x : enat} {y : enat} [Decidable (roption.dom x)] [Decidable (roption.dom y)] : to_with_top x ≤ to_with_top y ↔ x ≤ y := sorry

@[simp] theorem to_with_top_lt {x : enat} {y : enat} [Decidable (roption.dom x)] [Decidable (roption.dom y)] : to_with_top x < to_with_top y ↔ x < y :=
  lt_iff_lt_of_le_iff_le to_with_top_le

@[simp] theorem to_with_top_add {x : enat} {y : enat} : to_with_top (x + y) = to_with_top x + to_with_top y := sorry

/-- `equiv` between `enat` and `with_top ℕ` (for the order isomorphism see `with_top_order_iso`). -/
def with_top_equiv : enat ≃ with_top ℕ :=
  equiv.mk (fun (x : enat) => to_with_top x) (fun (x : with_top ℕ) => sorry) sorry sorry

@[simp] theorem with_top_equiv_top : coe_fn with_top_equiv ⊤ = ⊤ :=
  to_with_top_top'

@[simp] theorem with_top_equiv_coe (n : ℕ) : coe_fn with_top_equiv ↑n = ↑n :=
  to_with_top_coe' n

@[simp] theorem with_top_equiv_zero : coe_fn with_top_equiv 0 = 0 :=
  with_top_equiv_coe 0

@[simp] theorem with_top_equiv_le {x : enat} {y : enat} : coe_fn with_top_equiv x ≤ coe_fn with_top_equiv y ↔ x ≤ y :=
  to_with_top_le

@[simp] theorem with_top_equiv_lt {x : enat} {y : enat} : coe_fn with_top_equiv x < coe_fn with_top_equiv y ↔ x < y :=
  to_with_top_lt

/-- `to_with_top` induces an order isomorphism between `enat` and `with_top ℕ`. -/
def with_top_order_iso : enat ≃o with_top ℕ :=
  rel_iso.mk (equiv.mk (equiv.to_fun with_top_equiv) (equiv.inv_fun with_top_equiv) sorry sorry) sorry

@[simp] theorem with_top_equiv_symm_top : coe_fn (equiv.symm with_top_equiv) ⊤ = ⊤ :=
  rfl

@[simp] theorem with_top_equiv_symm_coe (n : ℕ) : coe_fn (equiv.symm with_top_equiv) ↑n = ↑n :=
  rfl

@[simp] theorem with_top_equiv_symm_zero : coe_fn (equiv.symm with_top_equiv) 0 = 0 :=
  rfl

@[simp] theorem with_top_equiv_symm_le {x : with_top ℕ} {y : with_top ℕ} : coe_fn (equiv.symm with_top_equiv) x ≤ coe_fn (equiv.symm with_top_equiv) y ↔ x ≤ y := sorry

@[simp] theorem with_top_equiv_symm_lt {x : with_top ℕ} {y : with_top ℕ} : coe_fn (equiv.symm with_top_equiv) x < coe_fn (equiv.symm with_top_equiv) y ↔ x < y := sorry

/-- `to_with_top` induces an additive monoid isomorphism between `enat` and `with_top ℕ`. -/
def with_top_add_equiv : enat ≃+ with_top ℕ :=
  add_equiv.mk (equiv.to_fun with_top_equiv) (equiv.inv_fun with_top_equiv) sorry sorry sorry

theorem lt_wf : well_founded Less := sorry

protected instance has_well_founded : has_well_founded enat :=
  has_well_founded.mk Less lt_wf

/-- The smallest `enat` satisfying a (decidable) predicate `P : ℕ → Prop` -/
def find (P : ℕ → Prop) [decidable_pred P] : enat :=
  roption.mk (∃ (n : ℕ), P n) nat.find

@[simp] theorem find_get (P : ℕ → Prop) [decidable_pred P] (h : roption.dom (find P)) : roption.get (find P) h = nat.find h :=
  rfl

theorem find_dom (P : ℕ → Prop) [decidable_pred P] (h : ∃ (n : ℕ), P n) : roption.dom (find P) :=
  h

theorem lt_find (P : ℕ → Prop) [decidable_pred P] (n : ℕ) (h : ∀ (m : ℕ), m ≤ n → ¬P m) : ↑n < find P := sorry

theorem lt_find_iff (P : ℕ → Prop) [decidable_pred P] (n : ℕ) : ↑n < find P ↔ ∀ (m : ℕ), m ≤ n → ¬P m := sorry

theorem find_le (P : ℕ → Prop) [decidable_pred P] (n : ℕ) (h : P n) : find P ≤ ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (find P ≤ ↑n)) (propext (le_coe_iff (find P) n))))
    (Exists.intro (Exists.intro n h) (nat.find_min' (Exists.intro n h) h))

theorem find_eq_top_iff (P : ℕ → Prop) [decidable_pred P] : find P = ⊤ ↔ ∀ (n : ℕ), ¬P n :=
  iff.trans (eq_top_iff_forall_lt (find P))
    { mp := fun (h : ∀ (n : ℕ), ↑n < find P) (n : ℕ) => iff.mp (lt_find_iff P n) (h n) n le_rfl,
      mpr := fun (h : ∀ (n : ℕ), ¬P n) (n : ℕ) => lt_find P n fun (_x : ℕ) (_x_1 : _x ≤ n) => h _x }


/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo, Bhavik Mehta, Yaël Dillies

! This file was ported from Lean 3 source module analysis.locally_convex.basic
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Basic
import Mathbin.Analysis.Convex.Hull
import Mathbin.Analysis.NormedSpace.Basic

/-!
# Local convexity

This file defines absorbent and balanced sets.

An absorbent set is one that "surrounds" the origin. The idea is made precise by requiring that any
point belongs to all large enough scalings of the set. This is the vector world analog of a
topological neighborhood of the origin.

A balanced set is one that is everywhere around the origin. This means that `a • s ⊆ s` for all `a`
of norm less than `1`.

## Main declarations

For a module over a normed ring:
* `absorbs`: A set `s` absorbs a set `t` if all large scalings of `s` contain `t`.
* `absorbent`: A set `s` is absorbent if every point eventually belongs to all large scalings of
  `s`.
* `balanced`: A set `s` is balanced if `a • s ⊆ s` for all `a` of norm less than `1`.

## References

* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966]

## Tags

absorbent, balanced, locally convex, LCTVS
-/

open Set

open Pointwise Topology

variable {𝕜 𝕝 E : Type _} {ι : Sort _} {κ : ι → Sort _}

section SeminormedRing

variable [SeminormedRing 𝕜]

section SMul

variable (𝕜) [SMul 𝕜 E]

/-- A set `A` absorbs another set `B` if `B` is contained in all scalings of `A` by elements of
sufficiently large norm. -/
def Absorbs (A B : Set E) :=
  ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ‖a‖ → B ⊆ a • A
#align absorbs Absorbs

variable {𝕜} {s t u v A B : Set E}

@[simp]
theorem absorbs_empty {s : Set E} : Absorbs 𝕜 s (∅ : Set E) :=
  ⟨1, one_pos, fun a ha => Set.empty_subset _⟩
#align absorbs_empty absorbs_empty

theorem Absorbs.mono (hs : Absorbs 𝕜 s u) (hst : s ⊆ t) (hvu : v ⊆ u) : Absorbs 𝕜 t v :=
  let ⟨r, hr, h⟩ := hs
  ⟨r, hr, fun a ha => hvu.trans <| (h _ ha).trans <| smul_set_mono hst⟩
#align absorbs.mono Absorbs.mono

theorem Absorbs.mono_left (hs : Absorbs 𝕜 s u) (h : s ⊆ t) : Absorbs 𝕜 t u :=
  hs.mono h Subset.rfl
#align absorbs.mono_left Absorbs.mono_left

theorem Absorbs.mono_right (hs : Absorbs 𝕜 s u) (h : v ⊆ u) : Absorbs 𝕜 s v :=
  hs.mono Subset.rfl h
#align absorbs.mono_right Absorbs.mono_right

theorem Absorbs.union (hu : Absorbs 𝕜 s u) (hv : Absorbs 𝕜 s v) : Absorbs 𝕜 s (u ∪ v) :=
  by
  obtain ⟨a, ha, hu⟩ := hu
  obtain ⟨b, hb, hv⟩ := hv
  exact
    ⟨max a b, lt_max_of_lt_left ha, fun c hc =>
      union_subset (hu _ <| le_of_max_le_left hc) (hv _ <| le_of_max_le_right hc)⟩
#align absorbs.union Absorbs.union

@[simp]
theorem absorbs_union : Absorbs 𝕜 s (u ∪ v) ↔ Absorbs 𝕜 s u ∧ Absorbs 𝕜 s v :=
  ⟨fun h => ⟨h.mono_right <| subset_union_left _ _, h.mono_right <| subset_union_right _ _⟩,
    fun h => h.1.union h.2⟩
#align absorbs_union absorbs_union

theorem absorbs_unionᵢ_finset {ι : Type _} {t : Finset ι} {f : ι → Set E} :
    Absorbs 𝕜 s (⋃ i ∈ t, f i) ↔ ∀ i ∈ t, Absorbs 𝕜 s (f i) := by
  classical
    induction' t using Finset.induction_on with i t ht hi
    ·
      simp only [Finset.not_mem_empty, Set.unionᵢ_false, Set.unionᵢ_empty, absorbs_empty,
        IsEmpty.forall_iff, imp_true_iff]
    rw [Finset.set_bunionᵢ_insert, absorbs_union, hi]
    constructor <;> intro h
    · refine' fun _ hi' => (finset.mem_insert.mp hi').elim _ (h.2 _)
      exact fun hi'' => by
        rw [hi'']
        exact h.1
    exact ⟨h i (Finset.mem_insert_self i t), fun i' hi' => h i' (Finset.mem_insert_of_mem hi')⟩
#align absorbs_Union_finset absorbs_unionᵢ_finset

theorem Set.Finite.absorbs_unionᵢ {ι : Type _} {s : Set E} {t : Set ι} {f : ι → Set E}
    (hi : t.Finite) : Absorbs 𝕜 s (⋃ i ∈ t, f i) ↔ ∀ i ∈ t, Absorbs 𝕜 s (f i) :=
  by
  lift t to Finset ι using hi
  simp only [Finset.mem_coe]
  exact absorbs_unionᵢ_finset
#align set.finite.absorbs_Union Set.Finite.absorbs_unionᵢ

variable (𝕜)

/-- A set is absorbent if it absorbs every singleton. -/
def Absorbent (A : Set E) :=
  ∀ x, ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ‖a‖ → x ∈ a • A
#align absorbent Absorbent

variable {𝕜}

theorem Absorbent.subset (hA : Absorbent 𝕜 A) (hAB : A ⊆ B) : Absorbent 𝕜 B :=
  by
  refine' forall_imp (fun x => _) hA
  exact Exists.imp fun r => And.imp_right <| forall₂_imp fun a ha hx => Set.smul_set_mono hAB hx
#align absorbent.subset Absorbent.subset

theorem absorbent_iff_forall_absorbs_singleton : Absorbent 𝕜 A ↔ ∀ x, Absorbs 𝕜 A {x} := by
  simp_rw [Absorbs, Absorbent, singleton_subset_iff]
#align absorbent_iff_forall_absorbs_singleton absorbent_iff_forall_absorbs_singleton

theorem Absorbent.absorbs (hs : Absorbent 𝕜 s) {x : E} : Absorbs 𝕜 s {x} :=
  absorbent_iff_forall_absorbs_singleton.1 hs _
#align absorbent.absorbs Absorbent.absorbs

theorem absorbent_iff_nonneg_lt :
    Absorbent 𝕜 A ↔ ∀ x, ∃ r, 0 ≤ r ∧ ∀ ⦃a : 𝕜⦄, r < ‖a‖ → x ∈ a • A :=
  forall_congr' fun x =>
    ⟨fun ⟨r, hr, hx⟩ => ⟨r, hr.le, fun a ha => hx a ha.le⟩, fun ⟨r, hr, hx⟩ =>
      ⟨r + 1, add_pos_of_nonneg_of_pos hr zero_lt_one, fun a ha =>
        hx ((lt_add_of_pos_right r zero_lt_one).trans_le ha)⟩⟩
#align absorbent_iff_nonneg_lt absorbent_iff_nonneg_lt

theorem Absorbent.absorbs_finite {s : Set E} (hs : Absorbent 𝕜 s) {v : Set E} (hv : v.Finite) :
    Absorbs 𝕜 s v := by
  rw [← Set.bunionᵢ_of_singleton v]
  exact hv.absorbs_Union.mpr fun _ _ => hs.absorbs
#align absorbent.absorbs_finite Absorbent.absorbs_finite

variable (𝕜)

/-- A set `A` is balanced if `a • A` is contained in `A` whenever `a` has norm at most `1`. -/
def Balanced (A : Set E) :=
  ∀ a : 𝕜, ‖a‖ ≤ 1 → a • A ⊆ A
#align balanced Balanced

variable {𝕜}

theorem balanced_iff_smul_mem : Balanced 𝕜 s ↔ ∀ ⦃a : 𝕜⦄, ‖a‖ ≤ 1 → ∀ ⦃x : E⦄, x ∈ s → a • x ∈ s :=
  forall₂_congr fun a ha => smul_set_subset_iff
#align balanced_iff_smul_mem balanced_iff_smul_mem

alias balanced_iff_smul_mem ↔ Balanced.smul_mem _
#align balanced.smul_mem Balanced.smul_mem

@[simp]
theorem balanced_empty : Balanced 𝕜 (∅ : Set E) := fun _ _ => by rw [smul_set_empty]
#align balanced_empty balanced_empty

@[simp]
theorem balanced_univ : Balanced 𝕜 (univ : Set E) := fun a ha => subset_univ _
#align balanced_univ balanced_univ

theorem Balanced.union (hA : Balanced 𝕜 A) (hB : Balanced 𝕜 B) : Balanced 𝕜 (A ∪ B) := fun a ha =>
  smul_set_union.Subset.trans <| union_subset_union (hA _ ha) <| hB _ ha
#align balanced.union Balanced.union

theorem Balanced.inter (hA : Balanced 𝕜 A) (hB : Balanced 𝕜 B) : Balanced 𝕜 (A ∩ B) := fun a ha =>
  smul_set_inter_subset.trans <| inter_subset_inter (hA _ ha) <| hB _ ha
#align balanced.inter Balanced.inter

theorem balanced_unionᵢ {f : ι → Set E} (h : ∀ i, Balanced 𝕜 (f i)) : Balanced 𝕜 (⋃ i, f i) :=
  fun a ha => (smul_set_Union _ _).Subset.trans <| unionᵢ_mono fun _ => h _ _ ha
#align balanced_Union balanced_unionᵢ

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem balanced_Union₂ {f : ∀ i, κ i → Set E} (h : ∀ i j, Balanced 𝕜 (f i j)) :
    Balanced 𝕜 (⋃ (i) (j), f i j) :=
  balanced_unionᵢ fun _ => balanced_unionᵢ <| h _
#align balanced_Union₂ balanced_Union₂

theorem balanced_interᵢ {f : ι → Set E} (h : ∀ i, Balanced 𝕜 (f i)) : Balanced 𝕜 (⋂ i, f i) :=
  fun a ha => (smul_set_interᵢ_subset _ _).trans <| interᵢ_mono fun _ => h _ _ ha
#align balanced_Inter balanced_interᵢ

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem balanced_Inter₂ {f : ∀ i, κ i → Set E} (h : ∀ i j, Balanced 𝕜 (f i j)) :
    Balanced 𝕜 (⋂ (i) (j), f i j) :=
  balanced_interᵢ fun _ => balanced_interᵢ <| h _
#align balanced_Inter₂ balanced_Inter₂

variable [SMul 𝕝 E] [SMulCommClass 𝕜 𝕝 E]

theorem Balanced.smul (a : 𝕝) (hs : Balanced 𝕜 s) : Balanced 𝕜 (a • s) := fun b hb =>
  (smul_comm _ _ _).Subset.trans <| smul_set_mono <| hs _ hb
#align balanced.smul Balanced.smul

end SMul

section Module

variable [AddCommGroup E] [Module 𝕜 E] {s s₁ s₂ t t₁ t₂ : Set E}

theorem Absorbs.neg : Absorbs 𝕜 s t → Absorbs 𝕜 (-s) (-t) :=
  Exists.imp fun r =>
    And.imp_right <| forall₂_imp fun _ _ h => (neg_subset_neg.2 h).trans (smul_set_neg _ _).Superset
#align absorbs.neg Absorbs.neg

theorem Balanced.neg : Balanced 𝕜 s → Balanced 𝕜 (-s) :=
  forall₂_imp fun _ _ h => (smul_set_neg _ _).Subset.trans <| neg_subset_neg.2 h
#align balanced.neg Balanced.neg

theorem Absorbs.add : Absorbs 𝕜 s₁ t₁ → Absorbs 𝕜 s₂ t₂ → Absorbs 𝕜 (s₁ + s₂) (t₁ + t₂) :=
  fun ⟨r₁, hr₁, h₁⟩ ⟨r₂, hr₂, h₂⟩ =>
  ⟨max r₁ r₂, lt_max_of_lt_left hr₁, fun a ha =>
    (add_subset_add (h₁ _ <| le_of_max_le_left ha) <| h₂ _ <| le_of_max_le_right ha).trans
      (smul_add _ _ _).Superset⟩
#align absorbs.add Absorbs.add

theorem Balanced.add (hs : Balanced 𝕜 s) (ht : Balanced 𝕜 t) : Balanced 𝕜 (s + t) := fun a ha =>
  (smul_add _ _ _).Subset.trans <| add_subset_add (hs _ ha) <| ht _ ha
#align balanced.add Balanced.add

theorem Absorbs.sub (h₁ : Absorbs 𝕜 s₁ t₁) (h₂ : Absorbs 𝕜 s₂ t₂) : Absorbs 𝕜 (s₁ - s₂) (t₁ - t₂) :=
  by
  simp_rw [sub_eq_add_neg]
  exact h₁.add h₂.neg
#align absorbs.sub Absorbs.sub

theorem Balanced.sub (hs : Balanced 𝕜 s) (ht : Balanced 𝕜 t) : Balanced 𝕜 (s - t) :=
  by
  simp_rw [sub_eq_add_neg]
  exact hs.add ht.neg
#align balanced.sub Balanced.sub

theorem balanced_zero : Balanced 𝕜 (0 : Set E) := fun a ha => (smul_zero _).Subset
#align balanced_zero balanced_zero

end Module

end SeminormedRing

section NormedField

variable [NormedField 𝕜] [NormedRing 𝕝] [NormedSpace 𝕜 𝕝] [AddCommGroup E] [Module 𝕜 E]
  [SMulWithZero 𝕝 E] [IsScalarTower 𝕜 𝕝 E] {s t u v A B : Set E} {x : E} {a b : 𝕜}

/-- Scalar multiplication (by possibly different types) of a balanced set is monotone. -/
theorem Balanced.smul_mono (hs : Balanced 𝕝 s) {a : 𝕝} {b : 𝕜} (h : ‖a‖ ≤ ‖b‖) : a • s ⊆ b • s :=
  by
  obtain rfl | hb := eq_or_ne b 0
  · rw [norm_zero] at h
    rw [norm_eq_zero.1 (h.antisymm <| norm_nonneg _)]
    obtain rfl | h := s.eq_empty_or_nonempty
    · simp_rw [smul_set_empty]
    · simp_rw [zero_smul_set h]
  rintro _ ⟨x, hx, rfl⟩
  refine' ⟨b⁻¹ • a • x, _, smul_inv_smul₀ hb _⟩
  rw [← smul_assoc]
  refine' hs _ _ (smul_mem_smul_set hx)
  rw [norm_smul, norm_inv, ← div_eq_inv_mul]
  exact div_le_one_of_le h (norm_nonneg _)
#align balanced.smul_mono Balanced.smul_mono

/-- A balanced set absorbs itself. -/
theorem Balanced.absorbs_self (hA : Balanced 𝕜 A) : Absorbs 𝕜 A A :=
  by
  refine' ⟨1, zero_lt_one, fun a ha x hx => _⟩
  rw [mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.1 <| zero_lt_one.trans_le ha)]
  refine' hA a⁻¹ _ (smul_mem_smul_set hx)
  rw [norm_inv]
  exact inv_le_one ha
#align balanced.absorbs_self Balanced.absorbs_self

theorem Balanced.subset_smul (hA : Balanced 𝕜 A) (ha : 1 ≤ ‖a‖) : A ⊆ a • A :=
  by
  refine' (subset_set_smul_iff₀ _).2 (hA a⁻¹ _)
  · rintro rfl
    rw [norm_zero] at ha
    exact zero_lt_one.not_le ha
  · rw [norm_inv]
    exact inv_le_one ha
#align balanced.subset_smul Balanced.subset_smul

theorem Balanced.smul_eq (hA : Balanced 𝕜 A) (ha : ‖a‖ = 1) : a • A = A :=
  (hA _ ha.le).antisymm <| hA.subset_smul ha.ge
#align balanced.smul_eq Balanced.smul_eq

theorem Balanced.mem_smul_iff (hs : Balanced 𝕜 s) (h : ‖a‖ = ‖b‖) : a • x ∈ s ↔ b • x ∈ s :=
  by
  obtain rfl | hb := eq_or_ne b 0
  · rw [norm_zero, norm_eq_zero] at h
    rw [h]
  have ha : a ≠ 0 := norm_ne_zero_iff.1 (ne_of_eq_of_ne h <| norm_ne_zero_iff.2 hb)
  constructor <;> intro h' <;> [rw [← inv_mul_cancel_right₀ ha b],
      rw [← inv_mul_cancel_right₀ hb a]] <;>
    · rw [← smul_eq_mul, smul_assoc]
      refine' hs.smul_mem _ h'
      simp [← h, ha]
#align balanced.mem_smul_iff Balanced.mem_smul_iff

theorem Balanced.neg_mem_iff (hs : Balanced 𝕜 s) : -x ∈ s ↔ x ∈ s := by
  convert hs.mem_smul_iff (norm_neg 1) <;> simp only [neg_smul, one_smul]
#align balanced.neg_mem_iff Balanced.neg_mem_iff

theorem Absorbs.inter (hs : Absorbs 𝕜 s u) (ht : Absorbs 𝕜 t u) : Absorbs 𝕜 (s ∩ t) u :=
  by
  obtain ⟨a, ha, hs⟩ := hs
  obtain ⟨b, hb, ht⟩ := ht
  have h : 0 < max a b := lt_max_of_lt_left ha
  refine' ⟨max a b, lt_max_of_lt_left ha, fun c hc => _⟩
  rw [smul_set_inter₀ (norm_pos_iff.1 <| h.trans_le hc)]
  exact subset_inter (hs _ <| le_of_max_le_left hc) (ht _ <| le_of_max_le_right hc)
#align absorbs.inter Absorbs.inter

@[simp]
theorem absorbs_inter : Absorbs 𝕜 (s ∩ t) u ↔ Absorbs 𝕜 s u ∧ Absorbs 𝕜 t u :=
  ⟨fun h => ⟨h.mono_left <| inter_subset_left _ _, h.mono_left <| inter_subset_right _ _⟩, fun h =>
    h.1.inter h.2⟩
#align absorbs_inter absorbs_inter

theorem absorbent_univ : Absorbent 𝕜 (univ : Set E) :=
  by
  refine' fun x => ⟨1, zero_lt_one, fun a ha => _⟩
  rw [smul_set_univ₀ (norm_pos_iff.1 <| zero_lt_one.trans_le ha)]
  exact trivial
#align absorbent_univ absorbent_univ

variable [TopologicalSpace E] [ContinuousSMul 𝕜 E]

/-- Every neighbourhood of the origin is absorbent. -/
theorem absorbent_nhds_zero (hA : A ∈ 𝓝 (0 : E)) : Absorbent 𝕜 A :=
  by
  intro x
  obtain ⟨w, hw₁, hw₂, hw₃⟩ := mem_nhds_iff.mp hA
  have hc : Continuous fun t : 𝕜 => t • x := continuous_id.smul continuous_const
  obtain ⟨r, hr₁, hr₂⟩ :=
    metric.is_open_iff.mp (hw₂.preimage hc) 0 (by rwa [mem_preimage, zero_smul])
  have hr₃ := inv_pos.mpr (half_pos hr₁)
  refine' ⟨(r / 2)⁻¹, hr₃, fun a ha₁ => _⟩
  have ha₂ : 0 < ‖a‖ := hr₃.trans_le ha₁
  refine' (mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp ha₂) _ _).2 (hw₁ <| hr₂ _)
  rw [Metric.mem_ball, dist_zero_right, norm_inv]
  calc
    ‖a‖⁻¹ ≤ r / 2 := (inv_le (half_pos hr₁) ha₂).mp ha₁
    _ < r := half_lt_self hr₁

#align absorbent_nhds_zero absorbent_nhds_zero

/-- The union of `{0}` with the interior of a balanced set is balanced. -/
theorem balanced_zero_union_interior (hA : Balanced 𝕜 A) : Balanced 𝕜 ((0 : Set E) ∪ interior A) :=
  by
  intro a ha
  obtain rfl | h := eq_or_ne a 0
  · rw [zero_smul_set]
    exacts[subset_union_left _ _, ⟨0, Or.inl rfl⟩]
  · rw [← image_smul, image_union]
    apply union_subset_union
    · rw [image_zero, smul_zero]
      rfl
    ·
      calc
        a • interior A ⊆ interior (a • A) := (isOpenMap_smul₀ h).image_interior_subset A
        _ ⊆ interior A := interior_mono (hA _ ha)

#align balanced_zero_union_interior balanced_zero_union_interior

/-- The interior of a balanced set is balanced if it contains the origin. -/
theorem Balanced.interior (hA : Balanced 𝕜 A) (h : (0 : E) ∈ interior A) :
    Balanced 𝕜 (interior A) :=
  by
  rw [← union_eq_self_of_subset_left (singleton_subset_iff.2 h)]
  exact balanced_zero_union_interior hA
#align balanced.interior Balanced.interior

theorem Balanced.closure (hA : Balanced 𝕜 A) : Balanced 𝕜 (closure A) := fun a ha =>
  (image_closure_subset_closure_image <| continuous_id.const_smul _).trans <|
    closure_mono <| hA _ ha
#align balanced.closure Balanced.closure

end NormedField

section NontriviallyNormedField

variable [NontriviallyNormedField 𝕜] [AddCommGroup E] [Module 𝕜 E] {s : Set E}

theorem absorbs_zero_iff : Absorbs 𝕜 s 0 ↔ (0 : E) ∈ s :=
  by
  refine' ⟨_, fun h => ⟨1, zero_lt_one, fun a _ => zero_subset.2 <| zero_mem_smul_set h⟩⟩
  rintro ⟨r, hr, h⟩
  obtain ⟨a, ha⟩ := NormedSpace.exists_lt_norm 𝕜 𝕜 r
  have := h _ ha.le
  rwa [zero_subset, zero_mem_smul_set_iff] at this
  exact norm_ne_zero_iff.1 (hr.trans ha).ne'
#align absorbs_zero_iff absorbs_zero_iff

theorem Absorbent.zero_mem (hs : Absorbent 𝕜 s) : (0 : E) ∈ s :=
  absorbs_zero_iff.1 <| absorbent_iff_forall_absorbs_singleton.1 hs _
#align absorbent.zero_mem Absorbent.zero_mem

variable [Module ℝ E] [SMulCommClass ℝ 𝕜 E]

theorem balanced_convexHull_of_balanced (hs : Balanced 𝕜 s) : Balanced 𝕜 (convexHull ℝ s) :=
  by
  suffices Convex ℝ { x | ∀ a : 𝕜, ‖a‖ ≤ 1 → a • x ∈ convexHull ℝ s }
    by
    rw [balanced_iff_smul_mem] at hs⊢
    refine' fun a ha x hx => convexHull_min _ this hx a ha
    exact fun y hy a ha => subset_convexHull ℝ s (hs ha hy)
  intro x hx y hy u v hu hv huv a ha
  simp only [smul_add, ← smul_comm]
  exact convex_convexHull ℝ s (hx a ha) (hy a ha) hu hv huv
#align balanced_convex_hull_of_balanced balanced_convexHull_of_balanced

end NontriviallyNormedField

section Real

variable [AddCommGroup E] [Module ℝ E] {s : Set E}

theorem balanced_iff_neg_mem (hs : Convex ℝ s) : Balanced ℝ s ↔ ∀ ⦃x⦄, x ∈ s → -x ∈ s :=
  by
  refine' ⟨fun h x => h.neg_mem_iff.2, fun h a ha => smul_set_subset_iff.2 fun x hx => _⟩
  rw [Real.norm_eq_abs, abs_le] at ha
  rw [show a = -((1 - a) / 2) + (a - -1) / 2 by ring, add_smul, neg_smul, ← smul_neg]
  exact
    hs (h hx) hx (div_nonneg (sub_nonneg_of_le ha.2) zero_le_two)
      (div_nonneg (sub_nonneg_of_le ha.1) zero_le_two) (by ring)
#align balanced_iff_neg_mem balanced_iff_neg_mem

end Real


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pfunctor.multivariate.basic
import Mathlib.PostPort

universes u l u_1 u_2

namespace Mathlib

/-!
# The W construction as a multivariate polynomial functor.

W types are well-founded tree-like structures. They are defined
as the least fixpoint of a polynomial functor.

## Main definitions

 * `W_mk`     - constructor
 * `W_dest    - destructor
 * `W_rec`    - recursor: basis for defining functions by structural recursion on `P.W α`
 * `W_rec_eq` - defining equation for `W_rec`
 * `W_ind`    - induction principle for `P.W α`

## Implementation notes

Three views of M-types:

 * `Wp`: polynomial functor
 * `W`: data type inductively defined by a triple: shape of the root, data in the root and children of the root
 * `W`: least fixed point of a polynomial functor

Specifically, we define the polynomial functor `Wp` as:

 * A := a tree-like structure without information in the nodes
 * B := given the tree-like structure `t`, `B t` is a valid path
   (specified inductively by `W_path`) from the root of `t` to any given node.

As a result `Wp.obj α` is made of a dataless tree and a function from
its valid paths to values of `α`

## Reference

 * [Jeremy Avigad, Mario M. Carneiro and Simon Hudon, *Data Types as Quotients of Polynomial Functors*][avigad-carneiro-hudon2019]
-/

namespace mvpfunctor

/-- A path from the root of a tree to one of its node -/
inductive W_path {n : ℕ} (P : mvpfunctor (n + 1)) : pfunctor.W (last P) → fin2 n → Type u
where
| root : (a : A P) →
  (f : pfunctor.B (last P) a → pfunctor.W (last P)) → (i : fin2 n) → B (drop P) a i → W_path P (W_type.mk a f) i
| child : (a : A P) →
  (f : pfunctor.B (last P) a → pfunctor.W (last P)) →
    (i : fin2 n) → (j : pfunctor.B (last P) a) → W_path P (f j) i → W_path P (W_type.mk a f) i

protected instance W_path.inhabited {n : ℕ} (P : mvpfunctor (n + 1)) (x : pfunctor.W (last P)) {i : fin2 n} [I : Inhabited (B (drop P) (pfunctor.W.head x) i)] : Inhabited (W_path P x i) :=
  { default := sorry }

/-- Specialized destructor on `W_path` -/
def W_path_cases_on {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (g' : typevec.arrow (B (drop P) a) α) (g : (j : pfunctor.B (last P) a) → typevec.arrow (W_path P (f j)) α) : typevec.arrow (W_path P (W_type.mk a f)) α := sorry

/-- Specialized destructor on `W_path` -/
def W_path_dest_left {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (h : typevec.arrow (W_path P (W_type.mk a f)) α) : typevec.arrow (B (drop P) a) α :=
  fun (i : fin2 n) (c : B (drop P) a i) => h i (W_path.root a f i c)

/-- Specialized destructor on `W_path` -/
def W_path_dest_right {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (h : typevec.arrow (W_path P (W_type.mk a f)) α) (j : pfunctor.B (last P) a) : typevec.arrow (W_path P (f j)) α :=
  fun (i : fin2 n) (c : W_path P (f j) i) => h i (W_path.child a f i j c)

theorem W_path_dest_left_W_path_cases_on {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (g' : typevec.arrow (B (drop P) a) α) (g : (j : pfunctor.B (last P) a) → typevec.arrow (W_path P (f j)) α) : W_path_dest_left P (W_path_cases_on P g' g) = g' :=
  rfl

theorem W_path_dest_right_W_path_cases_on {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (g' : typevec.arrow (B (drop P) a) α) (g : (j : pfunctor.B (last P) a) → typevec.arrow (W_path P (f j)) α) : W_path_dest_right P (W_path_cases_on P g' g) = g :=
  rfl

theorem W_path_cases_on_eta {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (h : typevec.arrow (W_path P (W_type.mk a f)) α) : W_path_cases_on P (W_path_dest_left P h) (W_path_dest_right P h) = h := sorry

theorem comp_W_path_cases_on {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {β : typevec n} (h : typevec.arrow α β) {a : A P} {f : pfunctor.B (last P) a → pfunctor.W (last P)} (g' : typevec.arrow (B (drop P) a) α) (g : (j : pfunctor.B (last P) a) → typevec.arrow (W_path P (f j)) α) : typevec.comp h (W_path_cases_on P g' g) =
  W_path_cases_on P (typevec.comp h g') fun (i : pfunctor.B (last P) a) => typevec.comp h (g i) := sorry

/-- Polynomial functor for the W-type of `P`. `A` is a data-less well-founded
tree whereas, for a given `a : A`, `B a` is a valid path in tree `a` so
that `Wp.obj α` is made of a tree and a function from its valid paths to
the values it contains  -/
def Wp {n : ℕ} (P : mvpfunctor (n + 1)) : mvpfunctor n :=
  mk (pfunctor.W (last P)) (W_path P)

/-- W-type of `P` -/
def W {n : ℕ} (P : mvpfunctor (n + 1)) (α : typevec n) :=
  obj (Wp P) α

protected instance mvfunctor_W {n : ℕ} (P : mvpfunctor (n + 1)) : mvfunctor (W P) :=
  id (obj.mvfunctor (Wp P))

/-!
First, describe operations on `W` as a polynomial functor.
-/

/-- Constructor for `Wp` -/
def Wp_mk {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} (a : A P) (f : pfunctor.B (last P) a → pfunctor.W (last P)) (f' : typevec.arrow (W_path P (W_type.mk a f)) α) : W P α :=
  sigma.mk (W_type.mk a f) f'

/-- Recursor for `Wp` -/
def Wp_rec {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : Type u_2} (g : (a : A P) →
  (f : pfunctor.B (last P) a → pfunctor.W (last P)) →
    typevec.arrow (W_path P (W_type.mk a f)) α → (pfunctor.B (last P) a → C) → C) (x : pfunctor.W (last P)) (f' : typevec.arrow (W_path P x) α) : C :=
  sorry

theorem Wp_rec_eq {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : Type u_2} (g : (a : A P) →
  (f : pfunctor.B (last P) a → pfunctor.W (last P)) →
    typevec.arrow (W_path P (W_type.mk a f)) α → (pfunctor.B (last P) a → C) → C) (a : A P) (f : pfunctor.B (last P) a → pfunctor.W (last P)) (f' : typevec.arrow (W_path P (W_type.mk a f)) α) : Wp_rec P g (W_type.mk a f) f' = g a f f' fun (i : pfunctor.B (last P) a) => Wp_rec P g (f i) (W_path_dest_right P f' i) :=
  rfl

-- Note: we could replace Prop by Type* and obtain a dependent recursor

theorem Wp_ind {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : (x : pfunctor.W (last P)) → typevec.arrow (W_path P x) α → Prop} (ih : ∀ (a : A P) (f : pfunctor.B (last P) a → pfunctor.W (last P)) (f' : typevec.arrow (W_path P (W_type.mk a f)) α),
  (∀ (i : pfunctor.B (last P) a), C (f i) (W_path_dest_right P f' i)) → C (W_type.mk a f) f') (x : pfunctor.W (last P)) (f' : typevec.arrow (W_path P x) α) : C x f' := sorry

/-!
Now think of W as defined inductively by the data ⟨a, f', f⟩ where
- `a  : P.A` is the shape of the top node
- `f' : P.drop.B a ⟹ α` is the contents of the top node
- `f  : P.last.B a → P.last.W` are the subtrees
 -/

/-- Constructor for `W` -/
def W_mk {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α) : W P α :=
  let g : pfunctor.B (last P) a → pfunctor.W (last P) := fun (i : pfunctor.B (last P) a) => sigma.fst (f i);
  let g' : typevec.arrow (W_path P (W_type.mk a g)) α :=
    W_path_cases_on P f' fun (i : pfunctor.B (last P) a) => sigma.snd (f i);
  sigma.mk (W_type.mk a g) g'

/-- Recursor for `W` -/
def W_rec {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : Type u_1} (g : (a : A P) → typevec.arrow (B (drop P) a) α → (pfunctor.B (last P) a → W P α) → (pfunctor.B (last P) a → C) → C) : W P α → C :=
  sorry

/-- Defining equation for the recursor of `W` -/
theorem W_rec_eq {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : Type u_1} (g : (a : A P) → typevec.arrow (B (drop P) a) α → (pfunctor.B (last P) a → W P α) → (pfunctor.B (last P) a → C) → C) (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α) : W_rec P g (W_mk P a f' f) = g a f' f fun (i : pfunctor.B (last P) a) => W_rec P g (f i) := sorry

/-- Induction principle for `W` -/
theorem W_ind {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : W P α → Prop} (ih : ∀ (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α),
  (∀ (i : pfunctor.B (last P) a), C (f i)) → C (W_mk P a f' f)) (x : W P α) : C x := sorry

theorem W_cases {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {C : W P α → Prop} (ih : ∀ (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α), C (W_mk P a f' f)) (x : W P α) : C x :=
  W_ind P
    fun (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α)
      (ih' : ∀ (i : pfunctor.B (last P) a), C (f i)) => ih a f' f

/-- W-types are functorial -/
def W_map {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {β : typevec n} (g : typevec.arrow α β) : W P α → W P β :=
  fun (x : W P α) => mvfunctor.map g x

theorem W_mk_eq {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} (a : A P) (f : pfunctor.B (last P) a → pfunctor.W (last P)) (g' : typevec.arrow (B (drop P) a) α) (g : (j : pfunctor.B (last P) a) → typevec.arrow (W_path P (f j)) α) : (W_mk P a g' fun (i : pfunctor.B (last P) a) => sigma.mk (f i) (g i)) =
  sigma.mk (W_type.mk a f) (W_path_cases_on P g' g) :=
  rfl

theorem W_map_W_mk {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {β : typevec n} (g : typevec.arrow α β) (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α) : mvfunctor.map g (W_mk P a f' f) = W_mk P a (typevec.comp g f') fun (i : pfunctor.B (last P) a) => mvfunctor.map g (f i) := sorry

-- TODO: this technical theorem is used in one place in constructing the initial algebra.

-- Can it be avoided?

/-- Constructor of a value of `P.obj (α ::: β)` from components.
Useful to avoid complicated type annotation -/
def obj_append1 {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {β : Type u} (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → β) : obj P (α ::: β) :=
  sigma.mk a (typevec.split_fun f' f)

theorem map_obj_append1 {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} {γ : typevec n} (g : typevec.arrow α γ) (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α) : mvfunctor.map (g ::: W_map P g) (obj_append1 P a f' f) =
  obj_append1 P a (typevec.comp g f') fun (x : pfunctor.B (last P) a) => W_map P g (f x) := sorry

/-!
Yet another view of the W type: as a fixed point for a multivariate polynomial functor.
These are needed to use the W-construction to construct a fixed point of a qpf, since
the qpf axioms are expressed in terms of `map` on `P`.
-/

/-- Constructor for the W-type of `P` -/
def W_mk' {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} : obj P (α ::: W P α) → W P α :=
  sorry

/-- Destructor for the W-type of `P` -/
def W_dest' {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} : W P α → obj P (α ::: W P α) :=
  W_rec P
    fun (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α)
      (_x : pfunctor.B (last P) a → obj P (α ::: W P α)) => sigma.mk a (typevec.split_fun f' f)

theorem W_dest'_W_mk {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} (a : A P) (f' : typevec.arrow (B (drop P) a) α) (f : pfunctor.B (last P) a → W P α) : W_dest' P (W_mk P a f' f) = sigma.mk a (typevec.split_fun f' f) := sorry

theorem W_dest'_W_mk' {n : ℕ} (P : mvpfunctor (n + 1)) {α : typevec n} (x : obj P (α ::: W P α)) : W_dest' P (W_mk' P x) = x := sorry


inductive two
| c21
| c22

inductive three
| c31
| c32
| c33

lemma two_has_two_elements (a b c: two): a = b ∨ b = c ∨ c = a :=
begin
    cases a; cases b; cases c; repeat {refl <|> {left, refl} <|> right },
end

example : two ≠ three :=
begin
    intro,
    have h := two_has_two_elements,
    rw a at h,
    have := h three.c31 three.c32 three.c33,
    simp at this,
    assumption,
end


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Andrew Yang
-/
import category_theory.limits.shapes.terminal
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.binary_products

/-!
# Constructing binary product from pullbacks and terminal object.

The product is the pullback over the terminal objects. In particular, if a category
has pullbacks and a terminal object, then it has binary products.

We also provide the dual.
-/

universes v u

open category_theory category_theory.category category_theory.limits

variables {C : Type u} [category.{v} C]

/-- The pullback over the terminal object is the product -/
def is_product_of_is_terminal_is_pullback {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X)
  (k : W ⟶ Y) (H₁ : is_terminal Z)
  (H₂ : is_limit (pullback_cone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _))) :
  is_limit (binary_fan.mk h k) :=
{ lift := λ c, H₂.lift (pullback_cone.mk
    (c.π.app ⟨walking_pair.left⟩) (c.π.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)),
  fac' := λ c j,
  begin
    cases j,
    convert H₂.fac (pullback_cone.mk (c.π.app ⟨walking_pair.left⟩)
      (c.π.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)) (some j) using 1,
    rcases j; refl,
  end,
  uniq' := λ c m hm,
  begin
    apply pullback_cone.is_limit.hom_ext H₂,
    { exact (hm ⟨walking_pair.left⟩).trans (H₂.fac (pullback_cone.mk (c.π.app ⟨walking_pair.left⟩)
        (c.π.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)) walking_cospan.left).symm },
    { exact (hm ⟨walking_pair.right⟩).trans (H₂.fac (pullback_cone.mk (c.π.app ⟨walking_pair.left⟩)
        (c.π.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)) walking_cospan.right).symm },
  end }

/-- The product is the pullback over the terminal object. -/
def is_pullback_of_is_terminal_is_product {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X)
  (k : W ⟶ Y) (H₁ : is_terminal Z)
  (H₂ : is_limit (binary_fan.mk h k)) :
  is_limit (pullback_cone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _)) :=
begin
  apply pullback_cone.is_limit_aux',
  intro s,
  use H₂.lift (binary_fan.mk s.fst s.snd),
  use H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.left⟩,
  use H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.right⟩,
  intros m h₁ h₂,
  apply H₂.hom_ext,
  rintro ⟨⟨⟩⟩,
  { exact h₁.trans (H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.left⟩).symm },
  { exact h₂.trans (H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.right⟩).symm }
end

/-- Any category with pullbacks and a terminal object has a limit cone for each walking pair. -/
noncomputable def limit_cone_of_terminal_and_pullbacks [has_terminal C] [has_pullbacks C]
  (F : discrete walking_pair ⥤ C) : limit_cone F :=
{ cone :=
  { X := pullback (terminal.from (F.obj ⟨walking_pair.left⟩))
                  (terminal.from (F.obj ⟨walking_pair.right⟩)),
    π := discrete.nat_trans (λ x, discrete.cases_on x
      (λ x, walking_pair.cases_on x pullback.fst pullback.snd)) },
  is_limit :=
  { lift := λ c, pullback.lift ((c.π).app ⟨walking_pair.left⟩)
                                ((c.π).app ⟨walking_pair.right⟩)
                                (subsingleton.elim _ _),
    fac' := λ s c, discrete.cases_on c
      (λ c, walking_pair.cases_on c (limit.lift_π _ _) (limit.lift_π _ _)),
    uniq' := λ s m J,
              begin
                rw [←J, ←J],
                ext;
                rw limit.lift_π;
                refl
              end } }

variable (C)

/-- Any category with pullbacks and terminal object has binary products. -/
-- This is not an instance, as it is not always how one wants to construct binary products!
lemma has_binary_products_of_terminal_and_pullbacks
  [has_terminal C] [has_pullbacks C] :
  has_binary_products C :=
{ has_limit := λ F, has_limit.mk (limit_cone_of_terminal_and_pullbacks F) }

/-- In a category with a terminal object and pullbacks,
a product of objects `X` and `Y` is isomorphic to a pullback. -/
noncomputable
def prod_iso_pullback [has_terminal C] [has_pullbacks C] (X Y : C) [has_binary_product X Y] :
  X ⨯ Y ≅ pullback (terminal.from X) (terminal.from Y) :=
limit.iso_limit_cone (limit_cone_of_terminal_and_pullbacks _)

variable {C}

/-- The pushout under the initial object is the coproduct -/
def is_coproduct_of_is_initial_is_pushout {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X)
  (k : W ⟶ Y) (H₁ : is_initial W)
  (H₂ : is_colimit (pushout_cocone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _))) :
  is_colimit (binary_cofan.mk f g) :=
{ desc := λ c, H₂.desc (pushout_cocone.mk
    (c.ι.app ⟨walking_pair.left⟩) (c.ι.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)),
  fac' := λ c j,
  begin
    cases j,
    convert H₂.fac (pushout_cocone.mk (c.ι.app ⟨walking_pair.left⟩) (c.ι.app ⟨walking_pair.right⟩)
      (H₁.hom_ext _ _)) (some j) using 1,
    cases j; refl
  end,
  uniq' := λ c m hm,
  begin
    apply pushout_cocone.is_colimit.hom_ext H₂,
    { exact (hm ⟨walking_pair.left⟩).trans (H₂.fac (pushout_cocone.mk (c.ι.app ⟨walking_pair.left⟩)
        (c.ι.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)) walking_cospan.left).symm },
    { exact (hm ⟨walking_pair.right⟩).trans (H₂.fac (pushout_cocone.mk (c.ι.app ⟨walking_pair.left⟩)
        (c.ι.app ⟨walking_pair.right⟩) (H₁.hom_ext _ _)) walking_cospan.right).symm },
  end }

/-- The coproduct is the pushout under the initial object. -/
def is_pushout_of_is_initial_is_coproduct {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X)
  (k : W ⟶ Y) (H₁ : is_initial W)
  (H₂ : is_colimit (binary_cofan.mk f g)) :
  is_colimit (pushout_cocone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _)) :=
begin
  apply pushout_cocone.is_colimit_aux',
  intro s,
  use H₂.desc (binary_cofan.mk s.inl s.inr),
  use H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.left⟩,
  use H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.right⟩,
  intros m h₁ h₂,
  apply H₂.hom_ext,
  rintro ⟨⟨⟩⟩,
  { exact h₁.trans (H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.left⟩).symm },
  { exact h₂.trans (H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.right⟩).symm }
end

/-- Any category with pushouts and an initial object has a colimit cocone for each walking pair. -/
noncomputable def colimit_cocone_of_initial_and_pushouts [has_initial C] [has_pushouts C]
  (F : discrete walking_pair ⥤ C) : colimit_cocone F :=
{ cocone :=
  { X := pushout (initial.to (F.obj ⟨walking_pair.left⟩))
                  (initial.to (F.obj ⟨walking_pair.right⟩)),
    ι := discrete.nat_trans (λ x, discrete.cases_on x
      (λ x, walking_pair.cases_on x pushout.inl pushout.inr)) },
  is_colimit :=
  { desc := λ c, pushout.desc (c.ι.app ⟨walking_pair.left⟩)
                              (c.ι.app ⟨walking_pair.right⟩)
                              (subsingleton.elim _ _),
    fac' := λ s c, discrete.cases_on c
      (λ c, walking_pair.cases_on c (colimit.ι_desc _ _) (colimit.ι_desc _ _)),
    uniq' := λ s m J,
              begin
                rw [←J, ←J],
                ext;
                rw colimit.ι_desc;
                refl
              end } }

variable (C)

/-- Any category with pushouts and initial object has binary coproducts. -/
-- This is not an instance, as it is not always how one wants to construct binary coproducts!
lemma has_binary_coproducts_of_initial_and_pushouts
  [has_initial C] [has_pushouts C] :
  has_binary_coproducts C :=
{ has_colimit := λ F, has_colimit.mk (colimit_cocone_of_initial_and_pushouts F) }

/-- In a category with an initial object and pushouts,
a coproduct of objects `X` and `Y` is isomorphic to a pushout. -/
noncomputable
def coprod_iso_pushout [has_initial C] [has_pushouts C] (X Y : C) [has_binary_coproduct X Y] :
  X ⨿ Y ≅ pushout (initial.to X) (initial.to Y) :=
colimit.iso_colimit_cocone (colimit_cocone_of_initial_and_pushouts _)


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import analysis.convex.basic
import topology.algebra.order.basic

/-!
# Strictly convex sets

This file defines strictly convex sets.

A set is strictly convex if the open segment between any two distinct points lies in its interior.
-/

open set
open_locale convex pointwise

variables {𝕜 𝕝 E F β : Type*}

open function set
open_locale convex

section ordered_semiring
variables [ordered_semiring 𝕜] [topological_space E] [topological_space F]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section has_scalar
variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 F] (s : set E)

/-- A set is strictly convex if the open segment between any two distinct points lies is in its
interior. This basically means "convex and not flat on the boundary". -/
def strict_convex : Prop :=
s.pairwise $ λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ interior s

variables {𝕜 s} {x y : E}

lemma strict_convex_iff_open_segment_subset :
  strict_convex 𝕜 s ↔ s.pairwise (λ x y, open_segment 𝕜 x y ⊆ interior s) :=
forall₅_congr $ λ x hx y hy hxy, (open_segment_subset_iff 𝕜).symm

lemma strict_convex.open_segment_subset (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s)
  (h : x ≠ y) :
  open_segment 𝕜 x y ⊆ interior s :=
strict_convex_iff_open_segment_subset.1 hs hx hy h

lemma strict_convex_empty : strict_convex 𝕜 (∅ : set E) := pairwise_empty _

lemma strict_convex_univ : strict_convex 𝕜 (univ : set E) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  rw interior_univ,
  exact mem_univ _,
end

protected lemma strict_convex.inter {t : set E} (hs : strict_convex 𝕜 s) (ht : strict_convex 𝕜 t) :
  strict_convex 𝕜 (s ∩ t) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  rw interior_inter,
  exact ⟨hs hx.1 hy.1 hxy ha hb hab, ht hx.2 hy.2 hxy ha hb hab⟩,
end

lemma directed.strict_convex_Union {ι : Sort*} {s : ι → set E} (hdir : directed (⊆) s)
  (hs : ∀ ⦃i : ι⦄, strict_convex 𝕜 (s i)) :
  strict_convex 𝕜 (⋃ i, s i) :=
begin
  rintro x hx y hy hxy a b ha hb hab,
  rw mem_Union at hx hy,
  obtain ⟨i, hx⟩ := hx,
  obtain ⟨j, hy⟩ := hy,
  obtain ⟨k, hik, hjk⟩ := hdir i j,
  exact interior_mono (subset_Union s k) (hs (hik hx) (hjk hy) hxy ha hb hab),
end

lemma directed_on.strict_convex_sUnion {S : set (set E)} (hdir : directed_on (⊆) S)
  (hS : ∀ s ∈ S, strict_convex 𝕜 s) :
  strict_convex 𝕜 (⋃₀ S) :=
begin
  rw sUnion_eq_Union,
  exact (directed_on_iff_directed.1 hdir).strict_convex_Union (λ s, hS _ s.2),
end

end has_scalar

section module
variables [module 𝕜 E] [module 𝕜 F] {s : set E}

protected lemma strict_convex.convex (hs : strict_convex 𝕜 s) : convex 𝕜 s :=
convex_iff_pairwise_pos.2 $ λ x hx y hy hxy a b ha hb hab, interior_subset $ hs hx hy hxy ha hb hab

/-- An open convex set is strictly convex. -/
protected lemma convex.strict_convex (h : is_open s) (hs : convex 𝕜 s) : strict_convex 𝕜 s :=
λ x hx y hy _ a b ha hb hab, h.interior_eq.symm ▸ hs hx hy ha.le hb.le hab

lemma is_open.strict_convex_iff (h : is_open s) : strict_convex 𝕜 s ↔ convex 𝕜 s :=
⟨strict_convex.convex, convex.strict_convex h⟩

lemma strict_convex_singleton (c : E) : strict_convex 𝕜 ({c} : set E) := pairwise_singleton _ _

lemma set.subsingleton.strict_convex (hs : s.subsingleton) : strict_convex 𝕜 s := hs.pairwise _

lemma strict_convex.linear_image [semiring 𝕝] [module 𝕝 E] [module 𝕝 F]
  [linear_map.compatible_smul E F 𝕜 𝕝] (hs : strict_convex 𝕜 s) (f : E →ₗ[𝕝] F)
  (hf : is_open_map f) :
  strict_convex 𝕜 (f '' s) :=
begin
  rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ hxy a b ha hb hab,
  refine hf.image_interior_subset _ ⟨a • x + b • y, hs hx hy (ne_of_apply_ne _ hxy) ha hb hab, _⟩,
  rw [map_add, f.map_smul_of_tower a, f.map_smul_of_tower b]
end

lemma strict_convex.is_linear_image (hs : strict_convex 𝕜 s) {f : E → F} (h : is_linear_map 𝕜 f)
  (hf : is_open_map f) :
  strict_convex 𝕜 (f '' s) :=
hs.linear_image (h.mk' f) hf

lemma strict_convex.linear_preimage {s : set F} (hs : strict_convex 𝕜 s) (f : E →ₗ[𝕜] F)
  (hf : continuous f) (hfinj : injective f) :
  strict_convex 𝕜 (s.preimage f) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  refine preimage_interior_subset_interior_preimage hf _,
  rw [mem_preimage, f.map_add, f.map_smul, f.map_smul],
  exact hs hx hy (hfinj.ne hxy) ha hb hab,
end

lemma strict_convex.is_linear_preimage {s : set F} (hs : strict_convex 𝕜 s) {f : E → F}
  (h : is_linear_map 𝕜 f) (hf : continuous f) (hfinj : injective f) :
  strict_convex 𝕜 (s.preimage f) :=
hs.linear_preimage (h.mk' f) hf hfinj

section linear_ordered_cancel_add_comm_monoid
variables [topological_space β] [linear_ordered_cancel_add_comm_monoid β] [order_topology β]
  [module 𝕜 β] [ordered_smul 𝕜 β]

lemma strict_convex_Iic (r : β) : strict_convex 𝕜 (Iic r) :=
begin
  rintro x (hx : x ≤ r) y (hy : y ≤ r) hxy a b ha hb hab,
  refine (subset_interior_iff_subset_of_open is_open_Iio).2 Iio_subset_Iic_self _,
  rw ←convex.combo_self hab r,
  obtain rfl | hx := hx.eq_or_lt,
  { exact add_lt_add_left (smul_lt_smul_of_pos (hy.lt_of_ne hxy.symm) hb) _ },
  obtain rfl | hy := hy.eq_or_lt,
  { exact add_lt_add_right (smul_lt_smul_of_pos hx ha) _ },
  { exact add_lt_add (smul_lt_smul_of_pos hx ha) (smul_lt_smul_of_pos hy hb) }
end

lemma strict_convex_Ici (r : β) : strict_convex 𝕜 (Ici r) :=
@strict_convex_Iic 𝕜 (order_dual β) _ _ _ _ _ _ r

lemma strict_convex_Icc (r s : β) : strict_convex 𝕜 (Icc r s) :=
(strict_convex_Ici r).inter $ strict_convex_Iic s

lemma strict_convex_Iio (r : β) : strict_convex 𝕜 (Iio r) :=
(convex_Iio r).strict_convex is_open_Iio

lemma strict_convex_Ioi (r : β) : strict_convex 𝕜 (Ioi r) :=
(convex_Ioi r).strict_convex is_open_Ioi

lemma strict_convex_Ioo (r s : β) : strict_convex 𝕜 (Ioo r s) :=
(strict_convex_Ioi r).inter $ strict_convex_Iio s

lemma strict_convex_Ico (r s : β) : strict_convex 𝕜 (Ico r s) :=
(strict_convex_Ici r).inter $ strict_convex_Iio s

lemma strict_convex_Ioc (r s : β) : strict_convex 𝕜 (Ioc r s) :=
(strict_convex_Ioi r).inter $ strict_convex_Iic s

lemma strict_convex_interval (r s : β) : strict_convex 𝕜 (interval r s) :=
strict_convex_Icc _ _

end linear_ordered_cancel_add_comm_monoid
end module
end add_comm_monoid

section add_cancel_comm_monoid
variables [add_cancel_comm_monoid E] [has_continuous_add E] [module 𝕜 E] {s : set E}

/-- The translation of a strictly convex set is also strictly convex. -/
lemma strict_convex.preimage_add_right (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, z + x) ⁻¹' s) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  refine preimage_interior_subset_interior_preimage (continuous_add_left _) _,
  have h := hs hx hy ((add_right_injective _).ne hxy) ha hb hab,
  rwa [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul] at h,
end

/-- The translation of a strictly convex set is also strictly convex. -/
lemma strict_convex.preimage_add_left (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, x + z) ⁻¹' s) :=
by simpa only [add_comm] using hs.preimage_add_right z

end add_cancel_comm_monoid

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F]

section continuous_add
variables [has_continuous_add E] {s t : set E}

lemma strict_convex.add (hs : strict_convex 𝕜 s) (ht : strict_convex 𝕜 t) :
  strict_convex 𝕜 (s + t) :=
begin
  rintro _ ⟨v, w, hv, hw, rfl⟩ _ ⟨x, y, hx, hy, rfl⟩ h a b ha hb hab,
  rw [smul_add, smul_add, add_add_add_comm],
  obtain rfl | hvx := eq_or_ne v x,
  { refine interior_mono (add_subset_add (singleton_subset_iff.2 hv) subset.rfl) _,
    rw [convex.combo_self hab, singleton_add],
    exact (is_open_map_add_left _).image_interior_subset _
      (mem_image_of_mem _ $ ht hw hy (ne_of_apply_ne _ h) ha hb hab) },
  exact subset_interior_add_left (add_mem_add (hs hv hx hvx ha hb hab) $
    ht.convex hw hy ha.le hb.le hab)
end

lemma strict_convex.add_left (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, z + x) '' s) :=
by simpa only [singleton_add] using (strict_convex_singleton z).add hs

lemma strict_convex.add_right (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, x + z) '' s) :=
by simpa only [add_comm] using hs.add_left z

/-- The translation of a strictly convex set is also strictly convex. -/
lemma strict_convex.vadd (hs : strict_convex 𝕜 s) (x : E) : strict_convex 𝕜 (x +ᵥ s) :=
hs.add_left x

end continuous_add

section continuous_smul
variables [linear_ordered_field 𝕝] [module 𝕝 E] [has_continuous_const_smul 𝕝 E]
  [linear_map.compatible_smul E E 𝕜 𝕝] {s : set E} {x : E}

lemma strict_convex.smul (hs : strict_convex 𝕜 s) (c : 𝕝) : strict_convex 𝕜 (c • s) :=
begin
  obtain rfl | hc := eq_or_ne c 0,
  { exact (subsingleton_zero_smul_set _).strict_convex },
  { exact hs.linear_image (linear_map.lsmul _ _ c) (is_open_map_smul₀ hc) }
end

lemma strict_convex.affinity [has_continuous_add E] (hs : strict_convex 𝕜 s) (z : E) (c : 𝕝) :
  strict_convex 𝕜 (z +ᵥ c • s) :=
(hs.smul c).vadd z

end continuous_smul
end add_comm_group
end ordered_semiring

section ordered_comm_semiring
variables [ordered_comm_semiring 𝕜] [topological_space E]

section add_comm_group
variables [add_comm_group E] [module 𝕜 E] [no_zero_smul_divisors 𝕜 E]
  [has_continuous_const_smul 𝕜 E] {s : set E}

lemma strict_convex.preimage_smul (hs : strict_convex 𝕜 s) (c : 𝕜) :
  strict_convex 𝕜 ((λ z, c • z) ⁻¹' s) :=
begin
  classical,
  obtain rfl | hc := eq_or_ne c 0,
  { simp_rw [zero_smul, preimage_const],
    split_ifs,
    { exact strict_convex_univ },
    { exact strict_convex_empty } },
  refine hs.linear_preimage (linear_map.lsmul _ _ c) _ (smul_right_injective E hc),
  unfold linear_map.lsmul linear_map.mk₂ linear_map.mk₂' linear_map.mk₂'ₛₗ,
  exact continuous_const_smul _,
end

end add_comm_group
end ordered_comm_semiring

section ordered_ring
variables [ordered_ring 𝕜] [topological_space E] [topological_space F]

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s : set E} {x y : E}

lemma strict_convex.eq_of_open_segment_subset_frontier [nontrivial 𝕜] [densely_ordered 𝕜]
  (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s) (h : open_segment 𝕜 x y ⊆ frontier s) :
  x = y :=
begin
  obtain ⟨a, ha₀, ha₁⟩ := densely_ordered.dense (0 : 𝕜) 1 zero_lt_one,
  classical,
  by_contra hxy,
  exact (h ⟨a, 1 - a, ha₀, sub_pos_of_lt ha₁, add_sub_cancel'_right _ _, rfl⟩).2
    (hs hx hy hxy ha₀ (sub_pos_of_lt ha₁) $ add_sub_cancel'_right _ _),
end

lemma strict_convex.add_smul_mem (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hxy : x + y ∈ s)
  (hy : y ≠ 0) {t : 𝕜} (ht₀ : 0 < t) (ht₁ : t < 1) :
  x + t • y ∈ interior s :=
begin
  have h : x + t • y = (1 - t) • x + t • (x + y),
  { rw [smul_add, ←add_assoc, ←add_smul, sub_add_cancel, one_smul] },
  rw h,
  refine hs hx hxy (λ h, hy $ add_left_cancel _) (sub_pos_of_lt ht₁) ht₀ (sub_add_cancel _ _),
  exact x,
  rw [←h, add_zero],
end

lemma strict_convex.smul_mem_of_zero_mem (hs : strict_convex 𝕜 s) (zero_mem : (0 : E) ∈ s)
  (hx : x ∈ s) (hx₀ : x ≠ 0) {t : 𝕜} (ht₀ : 0 < t) (ht₁ : t < 1) :
  t • x ∈ interior s :=
by simpa using hs.add_smul_mem zero_mem (by simpa using hx) hx₀ ht₀ ht₁

lemma strict_convex.add_smul_sub_mem (h : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y)
  {t : 𝕜} (ht₀ : 0 < t) (ht₁ : t < 1) : x + t • (y - x) ∈ interior s :=
begin
  apply h.open_segment_subset hx hy hxy,
  rw open_segment_eq_image',
  exact mem_image_of_mem _ ⟨ht₀, ht₁⟩,
end

/-- The preimage of a strictly convex set under an affine map is strictly convex. -/
lemma strict_convex.affine_preimage {s : set F} (hs : strict_convex 𝕜 s) {f : E →ᵃ[𝕜] F}
  (hf : continuous f) (hfinj : injective f) :
  strict_convex 𝕜 (f ⁻¹' s) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  refine preimage_interior_subset_interior_preimage hf _,
  rw [mem_preimage, convex.combo_affine_apply hab],
  exact hs hx hy (hfinj.ne hxy) ha hb hab,
end

/-- The image of a strictly convex set under an affine map is strictly convex. -/
lemma strict_convex.affine_image (hs : strict_convex 𝕜 s) {f : E →ᵃ[𝕜] F} (hf : is_open_map f) :
  strict_convex 𝕜 (f '' s) :=
begin
  rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ hxy a b ha hb hab,
  exact hf.image_interior_subset _ ⟨a • x + b • y, ⟨hs hx hy (ne_of_apply_ne _ hxy) ha hb hab,
    convex.combo_affine_apply hab⟩⟩,
end

lemma strict_convex.neg [topological_add_group E] (hs : strict_convex 𝕜 s) :
  strict_convex 𝕜 ((λ z, -z) '' s) :=
hs.is_linear_image is_linear_map.is_linear_map_neg (homeomorph.neg E).is_open_map

lemma strict_convex.neg_preimage [topological_add_group E] (hs : strict_convex 𝕜 s) :
  strict_convex 𝕜 ((λ z, -z) ⁻¹' s) :=
hs.is_linear_preimage is_linear_map.is_linear_map_neg continuous_id.neg neg_injective

end add_comm_group
end ordered_ring

section linear_ordered_field
variables [linear_ordered_field 𝕜] [topological_space E]

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s : set E} {x : E}

/-- Alternative definition of set strict convexity, using division. -/
lemma strict_convex_iff_div :
  strict_convex 𝕜 s ↔ s.pairwise
    (λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → (a / (a + b)) • x + (b / (a + b)) • y ∈ interior s) :=
⟨λ h x hx y hy hxy a b ha hb, begin
  apply h hx hy hxy (div_pos ha $ add_pos ha hb) (div_pos hb $ add_pos ha hb),
  rw ←add_div,
  exact div_self (add_pos ha hb).ne',
end, λ h x hx y hy hxy a b ha hb hab, by convert h hx hy hxy ha hb; rw [hab, div_one] ⟩

lemma strict_convex.mem_smul_of_zero_mem (hs : strict_convex 𝕜 s) (zero_mem : (0 : E) ∈ s)
  (hx : x ∈ s) (hx₀ : x ≠ 0) {t : 𝕜} (ht : 1 < t) :
  x ∈ t • interior s :=
begin
  rw mem_smul_set_iff_inv_smul_mem₀ (zero_lt_one.trans ht).ne',
  exact hs.smul_mem_of_zero_mem zero_mem hx hx₀ (inv_pos.2 $ zero_lt_one.trans ht)  (inv_lt_one ht),
end

end add_comm_group
end linear_ordered_field

/-!
#### Convex sets in an ordered space

Relates `convex` and `set.ord_connected`.
-/

section
variables [topological_space E]

/-- A set in a linear ordered field is strictly convex if and only if it is convex. -/
@[simp] lemma strict_convex_iff_convex [linear_ordered_field 𝕜] [topological_space 𝕜]
  [order_topology 𝕜] {s : set 𝕜} :
  strict_convex 𝕜 s ↔ convex 𝕜 s :=
begin
  refine ⟨strict_convex.convex, λ hs, strict_convex_iff_open_segment_subset.2 (λ x hx y hy hxy, _)⟩,
  obtain h | h := hxy.lt_or_lt,
  { refine (open_segment_subset_Ioo h).trans _,
    rw ←interior_Icc,
    exact interior_mono (Icc_subset_segment.trans $ hs.segment_subset hx hy) },
  { rw open_segment_symm,
    refine (open_segment_subset_Ioo h).trans _,
    rw ←interior_Icc,
    exact interior_mono (Icc_subset_segment.trans $ hs.segment_subset hy hx) }
end

lemma strict_convex_iff_ord_connected [linear_ordered_field 𝕜] [topological_space 𝕜]
  [order_topology 𝕜] {s : set 𝕜} :
  strict_convex 𝕜 s ↔ s.ord_connected :=
strict_convex_iff_convex.trans convex_iff_ord_connected

alias strict_convex_iff_ord_connected ↔ strict_convex.ord_connected _

end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.data.subtype.basic
import Mathlib.Lean3Lib.init.funext

universes u v

namespace Mathlib

namespace classical

/- the axiom -/

axiom choice {α : Sort u} : Nonempty α → αtheorem indefinite_description {α : Sort u} (p : α → Prop) (h : ∃ (x : α), p x) : Subtype fun (x : α) => p x := sorry

def some {α : Sort u} {p : α → Prop} (h : ∃ (x : α), p x) : α :=
  subtype.val (indefinite_description p h)

theorem some_spec {α : Sort u} {p : α → Prop} (h : ∃ (x : α), p x) : p (some h) :=
  subtype.property (indefinite_description p h)

/- Diaconescu's theorem: using function extensionality and propositional extensionality,
   we can get excluded middle from this. -/

/- TODO(Leo): check why the code generator is not ignoring (some exU)
   when we mark u as def. -/

theorem em (p : Prop) : p ∨ ¬p :=
  or.elim (not_uv_or_p p) (fun (hne : u p ≠ v p) => Or.inr (mt (p_implies_uv p) hne)) Or.inl

theorem exists_true_of_nonempty {α : Sort u} : Nonempty α → ∃ (x : α), True :=
  fun (ᾰ : Nonempty α) => nonempty.dcases_on ᾰ fun (ᾰ : α) => idRhs (∃ (x : α), True) (Exists.intro ᾰ trivial)

def inhabited_of_nonempty {α : Sort u} (h : Nonempty α) : Inhabited α :=
  { default := Classical.choice h }

def inhabited_of_exists {α : Sort u} {p : α → Prop} (h : ∃ (x : α), p x) : Inhabited α :=
  inhabited_of_nonempty sorry

/- all propositions are decidable -/

def prop_decidable (a : Prop) : Decidable a :=
  Classical.choice sorry

def decidable_inhabited (a : Prop) : Inhabited (Decidable a) :=
  { default := prop_decidable a }

def type_decidable_eq (α : Sort u) : DecidableEq α :=
  fun (x y : α) => prop_decidable (x = y)

def type_decidable (α : Sort u) : psum α (α → False) :=
  sorry

theorem strong_indefinite_description {α : Sort u} (p : α → Prop) (h : Nonempty α) : Subtype fun (x : α) => (∃ (y : α), p y) → p x := sorry

/- the Hilbert epsilon function -/

def epsilon {α : Sort u} [h : Nonempty α] (p : α → Prop) : α :=
  subtype.val (strong_indefinite_description p h)

theorem epsilon_spec_aux {α : Sort u} (h : Nonempty α) (p : α → Prop) : (∃ (y : α), p y) → p (epsilon p) :=
  subtype.property (strong_indefinite_description p h)

theorem epsilon_spec {α : Sort u} {p : α → Prop} (hex : ∃ (y : α), p y) : p (epsilon p) :=
  epsilon_spec_aux (nonempty_of_exists hex) p hex

theorem epsilon_singleton {α : Sort u} (x : α) : (epsilon fun (y : α) => y = x) = x :=
  epsilon_spec (Exists.intro x rfl)

/- the axiom of choice -/

theorem axiom_of_choice {α : Sort u} {β : α → Sort v} {r : (x : α) → β x → Prop} (h : ∀ (x : α), ∃ (y : β x), r x y) : ∃ (f : (x : α) → β x), ∀ (x : α), r x (f x) :=
  Exists.intro (fun (x : α) => some (h x)) fun (x : α) => some_spec (h x)

theorem skolem {α : Sort u} {b : α → Sort v} {p : (x : α) → b x → Prop} : (∀ (x : α), ∃ (y : b x), p x y) ↔ ∃ (f : (x : α) → b x), ∀ (x : α), p x (f x) := sorry

theorem prop_complete (a : Prop) : a = True ∨ a = False :=
  or.elim (em a) (fun (t : a) => Or.inl (eq_true_intro t)) fun (f : ¬a) => Or.inr (eq_false_intro f)

def eq_true_or_eq_false (a : Prop) : a = True ∨ a = False :=
  prop_complete

theorem cases_true_false (p : Prop → Prop) (h1 : p True) (h2 : p False) (a : Prop) : p a :=
  or.elim (prop_complete a) (fun (ht : a = True) => Eq.symm ht ▸ h1) fun (hf : a = False) => Eq.symm hf ▸ h2

theorem cases_on (a : Prop) {p : Prop → Prop} (h1 : p True) (h2 : p False) : p a :=
  cases_true_false p h1 h2 a

-- this supercedes by_cases in decidable

def by_cases {p : Prop} {q : Prop} (hpq : p → q) (hnpq : ¬p → q) : q :=
  decidable.by_cases hpq hnpq

-- this supercedes by_contradiction in decidable

theorem by_contradiction {p : Prop} (h : ¬p → False) : p :=
  decidable.by_contradiction h

theorem eq_false_or_eq_true (a : Prop) : a = False ∨ a = True :=
  or.symm (prop_complete a)