/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Alistair Tucker
-/
import order.complete_lattice_intervals
import topology.algebra.order.basic

/-!
# Intermediate Value Theorem

In this file we prove the Intermediate Value Theorem: if `f : α → β` is a function defined on a
connected set `s` that takes both values `≤ a` and values `≥ a` on `s`, then it is equal to `a` at
some point of `s`. We also prove that intervals in a dense conditionally complete order are
preconnected and any preconnected set is an interval. Then we specialize IVT to functions continuous
on intervals.

## Main results

* `is_preconnected_I??` : all intervals `I??` are preconnected,
* `is_preconnected.intermediate_value`, `intermediate_value_univ` : Intermediate Value Theorem for
  connected sets and connected spaces, respectively;
* `intermediate_value_Icc`, `intermediate_value_Icc'`: Intermediate Value Theorem for functions
  on closed intervals.

### Miscellaneous facts

* `is_closed.Icc_subset_of_forall_mem_nhds_within` : “Continuous induction” principle;
  if `s ∩ [a, b]` is closed, `a ∈ s`, and for each `x ∈ [a, b) ∩ s` some of its right neighborhoods
  is included `s`, then `[a, b] ⊆ s`.
* `is_closed.Icc_subset_of_forall_exists_gt`, `is_closed.mem_of_ge_of_forall_exists_gt` : two
  other versions of the “continuous induction” principle.

## Tags

intermediate value theorem, connected space, connected set
-/

open filter order_dual topological_space function set
open_locale topological_space filter

universes u v w

/-!
### Intermediate value theorem on a (pre)connected space

In this section we prove the following theorem (see `is_preconnected.intermediate_value₂`): if `f`
and `g` are two functions continuous on a preconnected set `s`, `f a ≤ g a` at some `a ∈ s` and
`g b ≤ f b` at some `b ∈ s`, then `f c = g c` at some `c ∈ s`. We prove several versions of this
statement, including the classical IVT that corresponds to a constant function `g`.
-/

section

variables {X : Type u} {α : Type v} [topological_space X]
  [linear_order α] [topological_space α] [order_closed_topology α]

/-- Intermediate value theorem for two functions: if `f` and `g` are two continuous functions
on a preconnected space and `f a ≤ g a` and `g b ≤ f b`, then for some `x` we have `f x = g x`. -/
lemma intermediate_value_univ₂ [preconnected_space X] {a b : X} {f g : X → α} (hf : continuous f)
  (hg : continuous g) (ha : f a ≤ g a) (hb : g b ≤ f b) :
  ∃ x, f x = g x :=
begin
  obtain ⟨x, h, hfg, hgf⟩ : (univ ∩ {x | f x ≤ g x ∧ g x ≤ f x}).nonempty,
    from is_preconnected_closed_iff.1 preconnected_space.is_preconnected_univ _ _
      (is_closed_le hf hg) (is_closed_le hg hf) (λ x hx, le_total _ _) ⟨a, trivial, ha⟩
      ⟨b, trivial, hb⟩,
  exact ⟨x, le_antisymm hfg hgf⟩
end

lemma intermediate_value_univ₂_eventually₁ [preconnected_space X] {a : X} {l : filter X} [ne_bot l]
  {f g : X → α} (hf : continuous f) (hg : continuous g) (ha : f a ≤ g a) (he : g ≤ᶠ[l] f) :
  ∃ x, f x = g x :=
let ⟨c, hc⟩ := he.frequently.exists in intermediate_value_univ₂ hf hg ha hc

lemma intermediate_value_univ₂_eventually₂ [preconnected_space X] {l₁ l₂ : filter X}
  [ne_bot l₁] [ne_bot l₂] {f g : X → α} (hf : continuous f) (hg : continuous g)
  (he₁ : f ≤ᶠ[l₁] g ) (he₂ : g ≤ᶠ[l₂] f) :
  ∃ x, f x = g x :=
let ⟨c₁, hc₁⟩ := he₁.frequently.exists, ⟨c₂, hc₂⟩ := he₂.frequently.exists in
intermediate_value_univ₂ hf hg hc₁ hc₂

/-- Intermediate value theorem for two functions: if `f` and `g` are two functions continuous
on a preconnected set `s` and for some `a b ∈ s` we have `f a ≤ g a` and `g b ≤ f b`,
then for some `x ∈ s` we have `f x = g x`. -/
lemma is_preconnected.intermediate_value₂ {s : set X} (hs : is_preconnected s)
  {a b : X} (ha : a ∈ s) (hb : b ∈ s) {f g : X → α}
  (hf : continuous_on f s) (hg : continuous_on g s) (ha' : f a ≤ g a) (hb' : g b ≤ f b) :
  ∃ x ∈ s, f x = g x :=
let ⟨x, hx⟩ := @intermediate_value_univ₂ s α _ _ _ _ (subtype.preconnected_space hs) ⟨a, ha⟩ ⟨b, hb⟩
  _ _ (continuous_on_iff_continuous_restrict.1 hf) (continuous_on_iff_continuous_restrict.1 hg)
  ha' hb'
in ⟨x, x.2, hx⟩

lemma is_preconnected.intermediate_value₂_eventually₁ {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f g : X → α}
  (hf : continuous_on f s) (hg : continuous_on g s) (ha' : f a ≤ g a) (he : g ≤ᶠ[l] f) :
  ∃ x ∈ s, f x = g x :=
begin
  rw continuous_on_iff_continuous_restrict at hf hg,
  obtain ⟨b, h⟩ := @intermediate_value_univ₂_eventually₁ _ _ _ _ _ _ (subtype.preconnected_space hs)
    ⟨a, ha⟩ _ (comap_coe_ne_bot_of_le_principal hl) _ _ hf hg ha' (eventually_comap' he),
  exact ⟨b, b.prop, h⟩,
end

lemma is_preconnected.intermediate_value₂_eventually₂ {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f g : X → α}
  (hf : continuous_on f s) (hg : continuous_on g s) (he₁ : f ≤ᶠ[l₁] g) (he₂ : g ≤ᶠ[l₂] f) :
  ∃ x ∈ s, f x = g x :=
begin
  rw continuous_on_iff_continuous_restrict at hf hg,
  obtain ⟨b, h⟩ := @intermediate_value_univ₂_eventually₂ _ _ _ _ _ _ (subtype.preconnected_space hs)
    _ _ (comap_coe_ne_bot_of_le_principal hl₁) (comap_coe_ne_bot_of_le_principal hl₂)
    _ _ hf hg (eventually_comap' he₁) (eventually_comap' he₂),
  exact ⟨b, b.prop, h⟩,
end

/-- **Intermediate Value Theorem** for continuous functions on connected sets. -/
lemma is_preconnected.intermediate_value {s : set X} (hs : is_preconnected s)
  {a b : X} (ha : a ∈ s) (hb : b ∈ s) {f : X → α} (hf : continuous_on f s) :
  Icc (f a) (f b) ⊆ f '' s :=
λ x hx, mem_image_iff_bex.2 $ hs.intermediate_value₂ ha hb hf continuous_on_const hx.1 hx.2

lemma is_preconnected.intermediate_value_Ico {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht : tendsto f l (𝓝 v)) :
  Ico (f a) v ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₁ ha hl
  hf continuous_on_const h.1 (eventually_ge_of_tendsto_gt h.2 ht)

lemma is_preconnected.intermediate_value_Ioc {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht : tendsto f l (𝓝 v)) :
  Ioc v (f a) ⊆ f '' s :=
λ y h, bex_def.1 $ bex.imp_right (λ x _, eq.symm) $ hs.intermediate_value₂_eventually₁ ha hl
  continuous_on_const hf h.2 (eventually_le_of_tendsto_lt h.1 ht)

lemma is_preconnected.intermediate_value_Ioo {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v₁ v₂ : α} (ht₁ : tendsto f l₁ (𝓝 v₁)) (ht₂ : tendsto f l₂ (𝓝 v₂)) :
  Ioo v₁ v₂ ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (eventually_le_of_tendsto_lt h.1 ht₁) (eventually_ge_of_tendsto_gt h.2 ht₂)

lemma is_preconnected.intermediate_value_Ici {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) (ht : tendsto f l at_top) :
  Ici (f a) ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₁ ha hl
  hf continuous_on_const h (tendsto_at_top.1 ht y)

lemma is_preconnected.intermediate_value_Iic {s : set X} (hs : is_preconnected s)
  {a : X} {l : filter X} (ha : a ∈ s) [ne_bot l] (hl : l ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) (ht : tendsto f l at_bot) :
  Iic (f a) ⊆ f '' s :=
λ y h, bex_def.1 $ bex.imp_right (λ x _, eq.symm) $ hs.intermediate_value₂_eventually₁ ha hl
  continuous_on_const hf h (tendsto_at_bot.1 ht y)

lemma is_preconnected.intermediate_value_Ioi {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht₁ : tendsto f l₁ (𝓝 v)) (ht₂ : tendsto f l₂ at_top) :
  Ioi v ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (eventually_le_of_tendsto_lt h ht₁) (tendsto_at_top.1 ht₂ y)

lemma is_preconnected.intermediate_value_Iio {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) {v : α} (ht₁ : tendsto f l₁ at_bot) (ht₂ : tendsto f l₂ (𝓝 v)) :
  Iio v ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (tendsto_at_bot.1 ht₁ y) (eventually_ge_of_tendsto_gt h ht₂)

lemma is_preconnected.intermediate_value_Iii {s : set X} (hs : is_preconnected s)
  {l₁ l₂ : filter X} [ne_bot l₁] [ne_bot l₂] (hl₁ : l₁ ≤ 𝓟 s) (hl₂ : l₂ ≤ 𝓟 s) {f : X → α}
  (hf : continuous_on f s) (ht₁ : tendsto f l₁ at_bot) (ht₂ : tendsto f l₂ at_top) :
  univ ⊆ f '' s :=
λ y h, bex_def.1 $ hs.intermediate_value₂_eventually₂ hl₁ hl₂
  hf continuous_on_const (tendsto_at_bot.1 ht₁ y) (tendsto_at_top.1 ht₂ y)

/-- **Intermediate Value Theorem** for continuous functions on connected spaces. -/
lemma intermediate_value_univ [preconnected_space X] (a b : X) {f : X → α} (hf : continuous f) :
  Icc (f a) (f b) ⊆ range f :=
λ x hx, intermediate_value_univ₂ hf continuous_const hx.1 hx.2

/-- **Intermediate Value Theorem** for continuous functions on connected spaces. -/
lemma mem_range_of_exists_le_of_exists_ge [preconnected_space X] {c : α} {f : X → α}
  (hf : continuous f) (h₁ : ∃ a, f a ≤ c) (h₂ : ∃ b, c ≤ f b) :
  c ∈ range f :=
let ⟨a, ha⟩ := h₁, ⟨b, hb⟩ := h₂ in intermediate_value_univ a b hf ⟨ha, hb⟩

/-!
### (Pre)connected sets in a linear order

In this section we prove the following results:

* `is_preconnected.ord_connected`: any preconnected set `s` in a linear order is `ord_connected`,
  i.e. `a ∈ s` and `b ∈ s` imply `Icc a b ⊆ s`;

* `is_preconnected.mem_intervals`: any preconnected set `s` in a conditionally complete linear order
  is one of the intervals `set.Icc`, `set.`Ico`, `set.Ioc`, `set.Ioo`, ``set.Ici`, `set.Iic`,
  `set.Ioi`, `set.Iio`; note that this is false for non-complete orders: e.g., in `ℝ \ {0}`, the set
  of positive numbers cannot be represented as `set.Ioi _`.

-/

/-- If a preconnected set contains endpoints of an interval, then it includes the whole interval. -/
lemma is_preconnected.Icc_subset {s : set α} (hs : is_preconnected s)
  {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  Icc a b ⊆ s :=
by simpa only [image_id] using hs.intermediate_value ha hb continuous_on_id

lemma is_preconnected.ord_connected {s : set α} (h : is_preconnected s) :
  ord_connected s :=
⟨λ x hx y hy, h.Icc_subset hx hy⟩

/-- If a preconnected set contains endpoints of an interval, then it includes the whole interval. -/
lemma is_connected.Icc_subset {s : set α} (hs : is_connected s)
  {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  Icc a b ⊆ s :=
hs.2.Icc_subset ha hb

/-- If preconnected set in a linear order space is unbounded below and above, then it is the whole
space. -/
lemma is_preconnected.eq_univ_of_unbounded {s : set α} (hs : is_preconnected s) (hb : ¬bdd_below s)
  (ha : ¬bdd_above s) :
  s = univ :=
begin
  refine eq_univ_of_forall (λ x, _),
  obtain ⟨y, ys, hy⟩ : ∃ y ∈ s, y < x := not_bdd_below_iff.1 hb x,
  obtain ⟨z, zs, hz⟩ : ∃ z ∈ s, x < z := not_bdd_above_iff.1 ha x,
  exact hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩
end

end

variables {α : Type u} {β : Type v} {γ : Type w}
  [conditionally_complete_linear_order α] [topological_space α] [order_topology α]
  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
  [nonempty γ]

/-- A bounded connected subset of a conditionally complete linear order includes the open interval
`(Inf s, Sup s)`. -/
lemma is_connected.Ioo_cInf_cSup_subset {s : set α} (hs : is_connected s) (hb : bdd_below s)
  (ha : bdd_above s) :
  Ioo (Inf s) (Sup s) ⊆ s :=
λ x hx, let ⟨y, ys, hy⟩ := (is_glb_lt_iff (is_glb_cInf hs.nonempty hb)).1 hx.1 in
let ⟨z, zs, hz⟩ := (lt_is_lub_iff (is_lub_cSup hs.nonempty ha)).1 hx.2 in
hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩

lemma eq_Icc_cInf_cSup_of_connected_bdd_closed {s : set α} (hc : is_connected s) (hb : bdd_below s)
  (ha : bdd_above s) (hcl : is_closed s) :
  s = Icc (Inf s) (Sup s) :=
subset.antisymm (subset_Icc_cInf_cSup hb ha) $
  hc.Icc_subset (hcl.cInf_mem hc.nonempty hb) (hcl.cSup_mem hc.nonempty ha)

lemma is_preconnected.Ioi_cInf_subset {s : set α} (hs : is_preconnected s) (hb : bdd_below s)
  (ha : ¬bdd_above s) :
  Ioi (Inf s) ⊆ s :=
begin
  have sne : s.nonempty := @nonempty_of_not_bdd_above α _ s ⟨Inf ∅⟩ ha,
  intros x hx,
  obtain ⟨y, ys, hy⟩ : ∃ y ∈ s, y < x := (is_glb_lt_iff (is_glb_cInf sne hb)).1 hx,
  obtain ⟨z, zs, hz⟩ : ∃ z ∈ s, x < z := not_bdd_above_iff.1 ha x,
  exact hs.Icc_subset ys zs ⟨le_of_lt hy, le_of_lt hz⟩
end

lemma is_preconnected.Iio_cSup_subset {s : set α} (hs : is_preconnected s) (hb : ¬bdd_below s)
  (ha : bdd_above s) :
  Iio (Sup s) ⊆ s :=
@is_preconnected.Ioi_cInf_subset (order_dual α) _ _ _ s hs ha hb

/-- A preconnected set in a conditionally complete linear order is either one of the intervals
`[Inf s, Sup s]`, `[Inf s, Sup s)`, `(Inf s, Sup s]`, `(Inf s, Sup s)`, `[Inf s, +∞)`,
`(Inf s, +∞)`, `(-∞, Sup s]`, `(-∞, Sup s)`, `(-∞, +∞)`, or `∅`. The converse statement requires
`α` to be densely ordererd. -/
lemma is_preconnected.mem_intervals {s : set α} (hs : is_preconnected s) :
  s ∈ ({Icc (Inf s) (Sup s), Ico (Inf s) (Sup s), Ioc (Inf s) (Sup s), Ioo (Inf s) (Sup s),
    Ici (Inf s), Ioi (Inf s), Iic (Sup s), Iio (Sup s), univ, ∅} : set (set α)) :=
begin
  rcases s.eq_empty_or_nonempty with rfl|hne,
  { apply_rules [or.inr, mem_singleton] },
  have hs' : is_connected s := ⟨hne, hs⟩,
  by_cases hb : bdd_below s; by_cases ha : bdd_above s,
  { rcases mem_Icc_Ico_Ioc_Ioo_of_subset_of_subset (hs'.Ioo_cInf_cSup_subset hb ha)
      (subset_Icc_cInf_cSup hb ha) with hs|hs|hs|hs,
    { exact (or.inl hs) },
    { exact (or.inr $ or.inl hs) },
    { exact (or.inr $ or.inr $ or.inl hs) },
    { exact (or.inr $ or.inr $ or.inr $ or.inl hs) } },
  { refine (or.inr $ or.inr $ or.inr $ or.inr _),
    cases mem_Ici_Ioi_of_subset_of_subset (hs.Ioi_cInf_subset hb ha) (λ x hx, cInf_le hb hx)
      with hs hs,
    { exact or.inl hs },
    { exact or.inr (or.inl hs) } },
  { iterate 6 { apply or.inr },
    cases mem_Iic_Iio_of_subset_of_subset (hs.Iio_cSup_subset hb ha) (λ x hx, le_cSup ha hx)
      with hs hs,
    { exact or.inl hs },
    { exact or.inr (or.inl hs) } },
  { iterate 8 { apply or.inr },
    exact or.inl (hs.eq_univ_of_unbounded hb ha) }
end

/-- A preconnected set is either one of the intervals `Icc`, `Ico`, `Ioc`, `Ioo`, `Ici`, `Ioi`,
`Iic`, `Iio`, or `univ`, or `∅`. The converse statement requires `α` to be densely ordered. Though
one can represent `∅` as `(Inf s, Inf s)`, we include it into the list of possible cases to improve
readability. -/
lemma set_of_is_preconnected_subset_of_ordered :
  {s : set α | is_preconnected s} ⊆
    -- bounded intervals
    (range (uncurry Icc) ∪ range (uncurry Ico) ∪ range (uncurry Ioc) ∪ range (uncurry Ioo)) ∪
    -- unbounded intervals and `univ`
    (range Ici ∪ range Ioi ∪ range Iic ∪ range Iio ∪ {univ, ∅}) :=
begin
  intros s hs,
  rcases hs.mem_intervals with hs|hs|hs|hs|hs|hs|hs|hs|hs|hs,
  { exact (or.inl $ or.inl $ or.inl $ or.inl ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inl $ or.inl $ or.inl $ or.inr ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inl $ or.inl $ or.inr ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inl $ or.inr ⟨(Inf s, Sup s), hs.symm⟩) },
  { exact (or.inr $ or.inl $ or.inl $ or.inl $ or.inl ⟨Inf s, hs.symm⟩) },
  { exact (or.inr $ or.inl $ or.inl $ or.inl $ or.inr ⟨Inf s, hs.symm⟩) },
  { exact (or.inr $ or.inl $ or.inl  $ or.inr ⟨Sup s, hs.symm⟩) },
  { exact (or.inr $ or.inl $  or.inr ⟨Sup s, hs.symm⟩) },
  { exact (or.inr $ or.inr $ or.inl hs) },
  { exact (or.inr $ or.inr $ or.inr hs) }
end

/-!
### Intervals are connected

In this section we prove that a closed interval (hence, any `ord_connected` set) in a dense
conditionally complete linear order is preconnected.
-/

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and the set `s ∩ [a, b)` has no maximal point, then `b ∈ s`. -/
lemma is_closed.mem_of_ge_of_forall_exists_gt {a b : α} {s : set α} (hs : is_closed (s ∩ Icc a b))
  (ha : a ∈ s) (hab : a ≤ b) (hgt : ∀ x ∈ s ∩ Ico a b, (s ∩ Ioc x b).nonempty) :
  b ∈ s :=
begin
  let S := s ∩ Icc a b,
  replace ha : a ∈ S, from ⟨ha, left_mem_Icc.2 hab⟩,
  have Sbd : bdd_above S, from ⟨b, λ z hz, hz.2.2⟩,
  let c := Sup (s ∩ Icc a b),
  have c_mem : c ∈ S, from hs.cSup_mem ⟨_, ha⟩ Sbd,
  have c_le : c ≤ b, from cSup_le ⟨_, ha⟩ (λ x hx, hx.2.2),
  cases eq_or_lt_of_le c_le with hc hc, from hc ▸ c_mem.1,
  exfalso,
  rcases hgt c ⟨c_mem.1, c_mem.2.1, hc⟩ with ⟨x, xs, cx, xb⟩,
  exact not_lt_of_le (le_cSup Sbd ⟨xs, le_trans (le_cSup Sbd ha) (le_of_lt cx), xb⟩) cx
end

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and for any `a ≤ x < y ≤ b`, `x ∈ s`, the set `s ∩ (x, y]`
is not empty, then `[a, b] ⊆ s`. -/
lemma is_closed.Icc_subset_of_forall_exists_gt {a b : α} {s : set α} (hs : is_closed (s ∩ Icc a b))
  (ha : a ∈ s) (hgt : ∀ x ∈ s ∩ Ico a b, ∀ y ∈ Ioi x, (s ∩ Ioc x y).nonempty) :
  Icc a b ⊆ s :=
begin
  assume y hy,
  have : is_closed (s ∩ Icc a y),
  { suffices : s ∩ Icc a y = s ∩ Icc a b ∩ Icc a y,
    { rw this, exact is_closed.inter hs is_closed_Icc },
    rw [inter_assoc],
    congr,
    exact (inter_eq_self_of_subset_right $ Icc_subset_Icc_right hy.2).symm },
  exact is_closed.mem_of_ge_of_forall_exists_gt this ha hy.1
    (λ x hx, hgt x ⟨hx.1, Ico_subset_Ico_right hy.2 hx.2⟩ y hx.2.2)
end

variables [densely_ordered α] {a b : α}

/-- A "continuous induction principle" for a closed interval: if a set `s` meets `[a, b]`
on a closed subset, contains `a`, and for any `x ∈ s ∩ [a, b)` the set `s` includes some open
neighborhood of `x` within `(x, +∞)`, then `[a, b] ⊆ s`. -/
lemma is_closed.Icc_subset_of_forall_mem_nhds_within {a b : α} {s : set α}
  (hs : is_closed (s ∩ Icc a b)) (ha : a ∈ s)
  (hgt : ∀ x ∈ s ∩ Ico a b, s ∈ 𝓝[>] x) :
  Icc a b ⊆ s :=
begin
  apply hs.Icc_subset_of_forall_exists_gt ha,
  rintros x ⟨hxs, hxab⟩ y hyxb,
  have : s ∩ Ioc x y ∈ 𝓝[>] x,
    from inter_mem (hgt x ⟨hxs, hxab⟩) (Ioc_mem_nhds_within_Ioi ⟨le_rfl, hyxb⟩),
  exact (nhds_within_Ioi_self_ne_bot' ⟨b, hxab.2⟩).nonempty_of_mem this
end

/-- A closed interval in a densely ordered conditionally complete linear order is preconnected. -/
lemma is_preconnected_Icc : is_preconnected (Icc a b) :=
is_preconnected_closed_iff.2
begin
  rintros s t hs ht hab ⟨x, hx⟩ ⟨y, hy⟩,
  wlog hxy : x ≤ y := le_total x y using [x y s t, y x t s],
  have xyab : Icc x y ⊆ Icc a b := Icc_subset_Icc hx.1.1 hy.1.2,
  by_contradiction hst,
  suffices : Icc x y ⊆ s,
    from hst ⟨y, xyab $ right_mem_Icc.2 hxy, this $ right_mem_Icc.2 hxy, hy.2⟩,
  apply (is_closed.inter hs is_closed_Icc).Icc_subset_of_forall_mem_nhds_within hx.2,
  rintros z ⟨zs, hz⟩,
  have zt : z ∈ tᶜ, from λ zt, hst ⟨z, xyab $ Ico_subset_Icc_self hz, zs, zt⟩,
  have : tᶜ ∩ Ioc z y ∈ 𝓝[>] z,
  { rw [← nhds_within_Ioc_eq_nhds_within_Ioi hz.2],
    exact mem_nhds_within.2 ⟨tᶜ, ht.is_open_compl, zt, subset.refl _⟩},
  apply mem_of_superset this,
  have : Ioc z y ⊆ s ∪ t, from λ w hw, hab (xyab ⟨le_trans hz.1 (le_of_lt hw.1), hw.2⟩),
  exact λ w ⟨wt, wzy⟩, (this wzy).elim id (λ h, (wt h).elim)
end

lemma is_preconnected_interval : is_preconnected (interval a b) := is_preconnected_Icc

lemma set.ord_connected.is_preconnected {s : set α} (h : s.ord_connected) :
  is_preconnected s :=
is_preconnected_of_forall_pair $ λ x hx y hy, ⟨interval x y, h.interval_subset hx hy,
  left_mem_interval, right_mem_interval, is_preconnected_interval⟩

lemma is_preconnected_iff_ord_connected {s : set α} :
  is_preconnected s ↔ ord_connected s :=
⟨is_preconnected.ord_connected, set.ord_connected.is_preconnected⟩

lemma is_preconnected_Ici : is_preconnected (Ici a) := ord_connected_Ici.is_preconnected
lemma is_preconnected_Iic : is_preconnected (Iic a) := ord_connected_Iic.is_preconnected
lemma is_preconnected_Iio : is_preconnected (Iio a) := ord_connected_Iio.is_preconnected
lemma is_preconnected_Ioi : is_preconnected (Ioi a) := ord_connected_Ioi.is_preconnected
lemma is_preconnected_Ioo : is_preconnected (Ioo a b) := ord_connected_Ioo.is_preconnected
lemma is_preconnected_Ioc : is_preconnected (Ioc a b) := ord_connected_Ioc.is_preconnected
lemma is_preconnected_Ico : is_preconnected (Ico a b) := ord_connected_Ico.is_preconnected

@[priority 100]
instance ordered_connected_space : preconnected_space α :=
⟨ord_connected_univ.is_preconnected⟩

/-- In a dense conditionally complete linear order, the set of preconnected sets is exactly
the set of the intervals `Icc`, `Ico`, `Ioc`, `Ioo`, `Ici`, `Ioi`, `Iic`, `Iio`, `(-∞, +∞)`,
or `∅`. Though one can represent `∅` as `(Inf s, Inf s)`, we include it into the list of
possible cases to improve readability. -/
lemma set_of_is_preconnected_eq_of_ordered :
  {s : set α | is_preconnected s} =
    -- bounded intervals
    (range (uncurry Icc) ∪ range (uncurry Ico) ∪ range (uncurry Ioc) ∪ range (uncurry Ioo)) ∪
    -- unbounded intervals and `univ`
    (range Ici ∪ range Ioi ∪ range Iic ∪ range Iio ∪ {univ, ∅}) :=
begin
  refine subset.antisymm set_of_is_preconnected_subset_of_ordered _,
  simp only [subset_def, -mem_range, forall_range_iff, uncurry, or_imp_distrib, forall_and_distrib,
    mem_union, mem_set_of_eq, insert_eq, mem_singleton_iff, forall_eq, forall_true_iff, and_true,
    is_preconnected_Icc, is_preconnected_Ico, is_preconnected_Ioc,
    is_preconnected_Ioo, is_preconnected_Ioi, is_preconnected_Iio, is_preconnected_Ici,
    is_preconnected_Iic, is_preconnected_univ, is_preconnected_empty],
end

/-!
### Intermediate Value Theorem on an interval

In this section we prove several versions of the Intermediate Value Theorem for a function
continuous on an interval.
-/

variables {δ : Type*} [linear_order δ] [topological_space δ] [order_closed_topology δ]

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, case
`f a ≤ t ≤ f b`.-/
lemma intermediate_value_Icc {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Icc (f a) (f b) ⊆ f '' (Icc a b) :=
is_preconnected_Icc.intermediate_value (left_mem_Icc.2 hab) (right_mem_Icc.2 hab) hf

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, case
`f a ≥ t ≥ f b`.-/
lemma intermediate_value_Icc' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Icc (f b) (f a) ⊆ f '' (Icc a b) :=
is_preconnected_Icc.intermediate_value (right_mem_Icc.2 hab) (left_mem_Icc.2 hab) hf

/-- **Intermediate Value Theorem** for continuous functions on closed intervals, unordered case. -/
lemma intermediate_value_interval {a b : α} {f : α → δ} (hf : continuous_on f (interval a b)) :
  interval (f a) (f b) ⊆ f '' interval a b :=
by cases le_total (f a) (f b); simp [*, is_preconnected_interval.intermediate_value]

lemma intermediate_value_Ico {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ico (f a) (f b) ⊆ f '' (Ico a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.2 (not_lt_of_le (he ▸ h.1)))
(λ hlt, @is_preconnected.intermediate_value_Ico _ _ _ _ _ _ _ (is_preconnected_Ico)
  _ _ ⟨refl a, hlt⟩ (right_nhds_within_Ico_ne_bot hlt) inf_le_right _ (hf.mono Ico_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ico_subset_Icc_self))

lemma intermediate_value_Ico' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioc (f b) (f a) ⊆ f '' (Ico a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.1 (not_lt_of_le (he ▸ h.2)))
(λ hlt, @is_preconnected.intermediate_value_Ioc _ _ _ _ _ _ _ (is_preconnected_Ico)
  _ _ ⟨refl a, hlt⟩ (right_nhds_within_Ico_ne_bot hlt) inf_le_right _ (hf.mono Ico_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ico_subset_Icc_self))

lemma intermediate_value_Ioc {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioc (f a) (f b) ⊆ f '' (Ioc a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.2 (not_le_of_lt (he ▸ h.1)))
(λ hlt, @is_preconnected.intermediate_value_Ioc _ _ _ _ _ _ _ (is_preconnected_Ioc)
  _ _ ⟨hlt, refl b⟩ (left_nhds_within_Ioc_ne_bot hlt) inf_le_right _ (hf.mono Ioc_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioc_subset_Icc_self))

lemma intermediate_value_Ioc' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ico (f b) (f a) ⊆ f '' (Ioc a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.1 (not_le_of_lt (he ▸ h.2)))
(λ hlt, @is_preconnected.intermediate_value_Ico _ _ _ _ _ _ _ (is_preconnected_Ioc)
  _ _ ⟨hlt, refl b⟩ (left_nhds_within_Ioc_ne_bot hlt) inf_le_right _ (hf.mono Ioc_subset_Icc_self)
  _ ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioc_subset_Icc_self))

lemma intermediate_value_Ioo {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioo (f a) (f b) ⊆ f '' (Ioo a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.2 (not_lt_of_lt (he ▸ h.1)))
(λ hlt, @is_preconnected.intermediate_value_Ioo _ _ _ _ _ _ _ (is_preconnected_Ioo)
  _ _ (left_nhds_within_Ioo_ne_bot hlt) (right_nhds_within_Ioo_ne_bot hlt)
  inf_le_right inf_le_right _ (hf.mono Ioo_subset_Icc_self)
  _ _ ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioo_subset_Icc_self)
  ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ioo_subset_Icc_self))

lemma intermediate_value_Ioo' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
  Ioo (f b) (f a) ⊆ f '' (Ioo a b) :=
or.elim (eq_or_lt_of_le hab) (λ he y h, absurd h.1 (not_lt_of_lt (he ▸ h.2)))
(λ hlt, @is_preconnected.intermediate_value_Ioo _ _ _ _ _ _ _ (is_preconnected_Ioo)
  _ _ (right_nhds_within_Ioo_ne_bot hlt) (left_nhds_within_Ioo_ne_bot hlt)
  inf_le_right inf_le_right _ (hf.mono Ioo_subset_Icc_self)
  _ _ ((hf.continuous_within_at ⟨hab, refl b⟩).mono Ioo_subset_Icc_self)
  ((hf.continuous_within_at ⟨refl a, hab⟩).mono Ioo_subset_Icc_self))

/-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
`b` are two points of this set, then `f` sends `s` to a superset of `Icc (f x) (f y)`. -/
lemma continuous_on.surj_on_Icc {s : set α} [hs : ord_connected s] {f : α → δ}
  (hf : continuous_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  surj_on f s (Icc (f a) (f b)) :=
hs.is_preconnected.intermediate_value ha hb hf

/-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
`b` are two points of this set, then `f` sends `s` to a superset of `[f x, f y]`. -/
lemma continuous_on.surj_on_interval {s : set α} [hs : ord_connected s] {f : α → δ}
  (hf : continuous_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  surj_on f s (interval (f a) (f b)) :=
by cases le_total (f a) (f b) with hab hab; simp [hf.surj_on_Icc, *]

/-- A continuous function which tendsto `at_top` `at_top` and to `at_bot` `at_bot` is surjective. -/
lemma continuous.surjective {f : α → δ} (hf : continuous f) (h_top : tendsto f at_top at_top)
  (h_bot : tendsto f at_bot at_bot) :
  function.surjective f :=
λ p, mem_range_of_exists_le_of_exists_ge hf
  (h_bot.eventually (eventually_le_at_bot p)).exists
  (h_top.eventually (eventually_ge_at_top p)).exists

/-- A continuous function which tendsto `at_bot` `at_top` and to `at_top` `at_bot` is surjective. -/
lemma continuous.surjective' {f : α → δ} (hf : continuous f) (h_top : tendsto f at_bot at_top)
  (h_bot : tendsto f at_top at_bot) :
  function.surjective f :=
@continuous.surjective (order_dual α) _ _ _ _ _ _ _ _ _ hf h_top h_bot

/-- If a function `f : α → β` is continuous on a nonempty interval `s`, its restriction to `s`
tends to `at_bot : filter β` along `at_bot : filter ↥s` and tends to `at_top : filter β` along
`at_top : filter ↥s`, then the restriction of `f` to `s` is surjective. We formulate the
conclusion as `surj_on f s univ`. -/
lemma continuous_on.surj_on_of_tendsto {f : α → δ} {s : set α} [ord_connected s]
  (hs : s.nonempty) (hf : continuous_on f s) (hbot : tendsto (λ x : s, f x) at_bot at_bot)
  (htop : tendsto (λ x : s, f x) at_top at_top) :
  surj_on f s univ :=
by haveI := classical.inhabited_of_nonempty hs.to_subtype;
  exact (surj_on_iff_surjective.2 $
    (continuous_on_iff_continuous_restrict.1 hf).surjective htop hbot)

/-- If a function `f : α → β` is continuous on a nonempty interval `s`, its restriction to `s`
tends to `at_top : filter β` along `at_bot : filter ↥s` and tends to `at_bot : filter β` along
`at_top : filter ↥s`, then the restriction of `f` to `s` is surjective. We formulate the
conclusion as `surj_on f s univ`. -/
lemma continuous_on.surj_on_of_tendsto' {f : α → δ} {s : set α} [ord_connected s]
  (hs : s.nonempty) (hf : continuous_on f s) (hbot : tendsto (λ x : s, f x) at_bot at_top)
  (htop : tendsto (λ x : s, f x) at_top at_bot) :
  surj_on f s univ :=
@continuous_on.surj_on_of_tendsto α _ _ _ _ (order_dual δ) _ _ _ _ _ _ hs hf hbot htop


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Devon Tuma
-/
import probability.probability_mass_function.basic

/-!
# Monad Operations for Probability Mass Functions

This file constructs two operations on `pmf` that give it a monad structure.
`pure a` is the distribution where a single value `a` has probability `1`.
`bind pa pb : pmf β` is the distribution given by sampling `a : α` from `pa : pmf α`,
and then sampling from `pb a : pmf β` to get a final result `b : β`.

`bind_on_support` generalizes `bind` to allow binding to a partial function,
so that the second argument only needs to be defined on the support of the first argument.

-/

noncomputable theory
variables {α β γ : Type*}
open_locale classical big_operators nnreal ennreal
open measure_theory

namespace pmf

section pure

/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
def pure (a : α) : pmf α := ⟨λ a', if a' = a then 1 else 0, has_sum_ite_eq _ _⟩

variables (a a' : α)

@[simp] lemma pure_apply : pure a a' = (if a' = a then 1 else 0) := rfl

@[simp] lemma support_pure : (pure a).support = {a} := set.ext (λ a', by simp [mem_support_iff])

lemma mem_support_pure_iff: a' ∈ (pure a).support ↔ a' = a := by simp

@[simp] lemma pure_apply_self : pure a a = 1 := if_pos rfl

lemma pure_apply_of_ne (h : a' ≠ a) : pure a a' = 0 := if_neg h

instance [inhabited α] : inhabited (pmf α) := ⟨pure default⟩

section measure

variable (s : set α)

@[simp] lemma to_outer_measure_pure_apply : (pure a).to_outer_measure s = if a ∈ s then 1 else 0 :=
begin
  refine (to_outer_measure_apply (pure a) s).trans _,
  split_ifs with ha ha,
  { refine ((tsum_congr (λ b, _)).trans (tsum_ite_eq a 1)),
    exact ite_eq_left_iff.2 (λ hb, symm (ite_eq_right_iff.2 (λ h, (hb $ h.symm ▸ ha).elim))) },
  { refine ((tsum_congr (λ b, _)).trans (tsum_zero)),
    exact ite_eq_right_iff.2 (λ hb, ite_eq_right_iff.2 (λ h, (ha $ h ▸ hb).elim)) }
end

variable [measurable_space α]

/-- The measure of a set under `pure a` is `1` for sets containing `a` and `0` otherwise -/
@[simp] lemma to_measure_pure_apply (hs : measurable_set s) :
  (pure a).to_measure s = if a ∈ s then 1 else 0 :=
(to_measure_apply_eq_to_outer_measure_apply (pure a) s hs).trans (to_outer_measure_pure_apply a s)

lemma to_measure_pure : (pure a).to_measure = measure.dirac a :=
measure.ext (λ s hs, by simpa only [to_measure_pure_apply a s hs, measure.dirac_apply' a hs])

@[simp] lemma to_pmf_dirac [countable α] [h : measurable_singleton_class α] :
  (measure.dirac a).to_pmf = pure a :=
by rw [to_pmf_eq_iff_to_measure_eq, to_measure_pure]

end measure

end pure

section bind

/-- The monadic bind operation for `pmf`. -/
def bind (p : pmf α) (f : α → pmf β) : pmf β :=
⟨λ b, ∑' a, p a * f a b, ennreal.summable.has_sum_iff.2 (ennreal.tsum_comm.trans $
  by simp only [ennreal.tsum_mul_left, tsum_coe, mul_one])⟩

variables (p : pmf α) (f : α → pmf β) (g : β → pmf γ)

@[simp] lemma bind_apply (b : β) : p.bind f b = ∑'a, p a * f a b := rfl

@[simp] lemma support_bind : (p.bind f).support = ⋃ a ∈ p.support, (f a).support :=
set.ext (λ b, by simp [mem_support_iff, ennreal.tsum_eq_zero, not_or_distrib])

lemma mem_support_bind_iff (b : β) : b ∈ (p.bind f).support ↔ ∃ a ∈ p.support, b ∈ (f a).support :=
by simp only [support_bind, set.mem_Union, set.mem_set_of_eq]

@[simp] lemma pure_bind (a : α) (f : α → pmf β) : (pure a).bind f = f a :=
have ∀ b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0, from
  assume b a', by split_ifs; simp; subst h; simp,
by ext b; simp [this]

@[simp] lemma bind_pure : p.bind pure = p :=
pmf.ext (λ x, (bind_apply _ _ _).trans (trans (tsum_eq_single x $
  (λ y hy, by rw [pure_apply_of_ne _ _ hy.symm, mul_zero])) $ by rw [pure_apply_self, mul_one]))

@[simp] lemma bind_const (p : pmf α) (q : pmf β) : p.bind (λ _, q) = q :=
pmf.ext (λ x, by rw [bind_apply, ennreal.tsum_mul_right, tsum_coe, one_mul])

@[simp]

lemma bind_comm (p : pmf α) (q : pmf β) (f : α → β → pmf γ) :
  p.bind (λ a, q.bind (f a)) = q.bind (λ b, p.bind (λ a, f a b)) :=
pmf.ext (λ b, by simpa only [ennreal.coe_eq_coe.symm, bind_apply, ennreal.tsum_mul_left.symm,
  ennreal.tsum_mul_right.symm, mul_assoc, mul_left_comm, mul_comm] using ennreal.tsum_comm)

section measure

variable (s : set β)

@[simp] lemma to_outer_measure_bind_apply :
  (p.bind f).to_outer_measure s = ∑' a, p a * (f a).to_outer_measure s :=
calc (p.bind f).to_outer_measure s
  = ∑' b, if b ∈ s then ∑' a, p a * f a b else 0 :
    by simp [to_outer_measure_apply, set.indicator_apply]
  ... = ∑' b a, p a * (if b ∈ s then f a b else 0) :
    tsum_congr (λ b, by split_ifs; simp)
  ... = ∑' a b, p a * (if b ∈ s then f a b else 0) :
    tsum_comm' ennreal.summable (λ _, ennreal.summable) (λ _, ennreal.summable)
  ... = ∑' a, p a * ∑' b, (if b ∈ s then f a b else 0) :
    tsum_congr (λ a, ennreal.tsum_mul_left)
  ... = ∑' a, p a * ∑' b, if b ∈ s then f a b else 0 :
    tsum_congr (λ a, congr_arg (λ x, (p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
  ... = ∑' a, p a * (f a).to_outer_measure s :
    tsum_congr (λ a, by simp only [to_outer_measure_apply, set.indicator_apply])

/-- The measure of a set under `p.bind f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a` -/
@[simp] lemma to_measure_bind_apply [measurable_space β] (hs : measurable_set s) :
  (p.bind f).to_measure s = ∑' a, p a * (f a).to_measure s :=
(to_measure_apply_eq_to_outer_measure_apply (p.bind f) s hs).trans
  ((to_outer_measure_bind_apply p f s).trans (tsum_congr (λ a, congr_arg (λ x, p a * x)
  (to_measure_apply_eq_to_outer_measure_apply (f a) s hs).symm)))

end measure

end bind

instance : monad pmf :=
{ pure := λ A a, pure a,
  bind := λ A B pa pb, pa.bind pb }

section bind_on_support

/-- Generalized version of `bind` allowing `f` to only be defined on the support of `p`.
  `p.bind f` is equivalent to `p.bind_on_support (λ a _, f a)`, see `bind_on_support_eq_bind` -/
def bind_on_support (p : pmf α) (f : Π a ∈ p.support, pmf β) : pmf β :=
⟨λ b, ∑' a, p a * if h : p a = 0 then 0 else f a h b,
ennreal.summable.has_sum_iff.2 begin
  refine (ennreal.tsum_comm.trans (trans (tsum_congr $ λ a, _) p.tsum_coe)),
  simp_rw [ennreal.tsum_mul_left],
  split_ifs with h,
  { simp only [h, zero_mul] },
  { rw [(f a h).tsum_coe, mul_one] }
end⟩

variables {p : pmf α} (f : Π a ∈ p.support, pmf β)

@[simp] lemma bind_on_support_apply (b : β) :
  p.bind_on_support f b = ∑' a, p a * if h : p a = 0 then 0 else f a h b := rfl

@[simp] lemma support_bind_on_support :
  (p.bind_on_support f).support = ⋃ (a : α) (h : a ∈ p.support), (f a h).support :=
begin
  refine set.ext (λ b, _),
  simp only [ennreal.tsum_eq_zero, not_or_distrib, mem_support_iff,
    bind_on_support_apply, ne.def, not_forall, mul_eq_zero, set.mem_Union],
  exact ⟨λ hb, let ⟨a, ⟨ha, ha'⟩⟩ := hb in ⟨a, ha, by simpa [ha] using ha'⟩,
    λ hb, let ⟨a, ha, ha'⟩ := hb in ⟨a, ⟨ha, by simpa [(mem_support_iff _ a).1 ha] using ha'⟩⟩⟩
end

lemma mem_support_bind_on_support_iff (b : β) :
  b ∈ (p.bind_on_support f).support ↔ ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support :=
by simp only [support_bind_on_support, set.mem_set_of_eq, set.mem_Union]

/-- `bind_on_support` reduces to `bind` if `f` doesn't depend on the additional hypothesis -/
@[simp] lemma bind_on_support_eq_bind (p : pmf α) (f : α → pmf β) :
  p.bind_on_support (λ a _, f a) = p.bind f :=
begin
  ext b x,
  have : ∀ a, ite (p a = 0) 0 (p a * f a b) = p a * f a b,
  from λ a, ite_eq_right_iff.2 (λ h, h.symm ▸ symm (zero_mul $ f a b)),
  simp only [bind_on_support_apply (λ a _, f a), p.bind_apply f,
    dite_eq_ite, mul_ite, mul_zero, this],
end

lemma bind_on_support_eq_zero_iff (b : β) :
  p.bind_on_support f b = 0 ↔ ∀ a (ha : p a ≠ 0), f a ha b = 0 :=
begin
  simp only [bind_on_support_apply, ennreal.tsum_eq_zero, mul_eq_zero, or_iff_not_imp_left],
  exact ⟨λ h a ha, trans (dif_neg ha).symm (h a ha), λ h a ha, trans (dif_neg ha) (h a ha)⟩,
end

@[simp] lemma pure_bind_on_support (a : α) (f : Π (a' : α) (ha : a' ∈ (pure a).support), pmf β) :
  (pure a).bind_on_support f = f a ((mem_support_pure_iff a a).mpr rfl) :=
begin
  refine pmf.ext (λ b, _),
  simp only [bind_on_support_apply, pure_apply],
  refine trans (tsum_congr (λ a', _)) (tsum_ite_eq a _),
  by_cases h : (a' = a); simp [h],
end

lemma bind_on_support_pure (p : pmf α) :
  p.bind_on_support (λ a _, pure a) = p :=
by simp only [pmf.bind_pure, pmf.bind_on_support_eq_bind]

@[simp] lemma bind_on_support_bind_on_support (p : pmf α)
  (f : ∀ a ∈ p.support, pmf β)
  (g : ∀ (b ∈ (p.bind_on_support f).support), pmf γ) :
  (p.bind_on_support f).bind_on_support g =
    p.bind_on_support (λ a ha, (f a ha).bind_on_support
      (λ b hb, g b ((mem_support_bind_on_support_iff f b).mpr ⟨a, ha, hb⟩))) :=
begin
  refine pmf.ext (λ a, _),
  simp only [ennreal.coe_eq_coe.symm, bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
  simp only [ennreal.tsum_eq_zero, ennreal.coe_eq_coe, ennreal.coe_eq_zero, ennreal.coe_zero,
    dite_eq_left_iff, mul_eq_zero],
  refine ennreal.tsum_comm.trans (tsum_congr (λ a', tsum_congr (λ b, _))),
  split_ifs,
  any_goals { ring1 },
  { have := h_1 a', simp [h] at this, contradiction },
  { simp [h_2], },
end

lemma bind_on_support_comm (p : pmf α) (q : pmf β)
  (f : ∀ (a ∈ p.support) (b ∈ q.support), pmf γ) :
  p.bind_on_support (λ a ha, q.bind_on_support (f a ha)) =
    q.bind_on_support (λ b hb, p.bind_on_support (λ a ha, f a ha b hb)) :=
begin
  apply pmf.ext, rintro c,
  simp only [ennreal.coe_eq_coe.symm, bind_on_support_apply, ← tsum_dite_right,
    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
  refine trans (ennreal.tsum_comm) (tsum_congr (λ b, tsum_congr (λ a, _))),
  split_ifs with h1 h2 h2; ring,
end

section measure

variable (s : set β)

@[simp] lemma to_outer_measure_bind_on_support_apply : (p.bind_on_support f).to_outer_measure s
  = ∑' a, p a * if h : p a = 0 then 0 else (f a h).to_outer_measure s :=
begin
  simp only [to_outer_measure_apply, set.indicator_apply, bind_on_support_apply],
  calc ∑' b, ite (b ∈ s) (∑' a, p a * dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0
    = ∑' b a, ite (b ∈ s) (p a * dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0 :
      tsum_congr (λ b, by split_ifs with hbs; simp only [eq_self_iff_true, tsum_zero])
    ... = ∑' a b, ite (b ∈ s) (p a * dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0 : ennreal.tsum_comm
    ... = ∑' a, p a * ∑' b, ite (b ∈ s) (dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0 :
      tsum_congr (λ a, by simp only [← ennreal.tsum_mul_left, mul_ite, mul_zero])
    ... = ∑' a, p a * dite (p a = 0) (λ h, 0) (λ h, ∑' b, ite (b ∈ s) (f a h b) 0) :
      tsum_congr (λ a, by split_ifs with ha; simp only [if_t_t, tsum_zero, eq_self_iff_true])
end

/-- The measure of a set under `p.bind_on_support f` is the sum over `a : α`
  of the probability of `a` under `p` times the measure of the set under `f a _`.
  The additional if statement is needed since `f` is only a partial function -/
@[simp] lemma to_measure_bind_on_support_apply [measurable_space β] (hs : measurable_set s) :
  (p.bind_on_support f).to_measure s
    = ∑' a, p a * if h : p a = 0 then 0 else (f a h).to_measure s :=
by simp only [to_measure_apply_eq_to_outer_measure_apply _ _ hs,
  to_outer_measure_bind_on_support_apply]

end measure

end bind_on_support

end pmf


/-
Copyright (c) 2022 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import data.finset.preimage

/-!
#  Unique products and related notions

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A group `G` has *unique products* if for any two non-empty finite subsets `A, B ⊂ G`, there is an
element `g ∈ A * B` that can be written uniquely as a product of an element of `A` and an element
of `B`.  We call the formalization this property `unique_prods`.  Since the condition requires no
property of the group operation, we define it for a Type simply satisfying `has_mul`.  We also
introduce the analogous "additive" companion, `unique_sums` and link the two so that `to_additive`
converts `unique_prods` into `unique_sums`.

Here you can see several examples of Types that have `unique_sums/prods`
(`apply_instance` uses `covariants.to_unique_prods` and `covariants.to_unique_sums`).
```lean
import data.real.basic

example : unique_sums ℕ   := by apply_instance
example : unique_sums ℕ+  := by apply_instance
example : unique_sums ℤ   := by apply_instance
example : unique_sums ℚ   := by apply_instance
example : unique_sums ℝ   := by apply_instance
example : unique_prods ℕ+ := by apply_instance
```
-/

/--  Let `G` be a Type with multiplication, let `A B : finset G` be finite subsets and
let `a0 b0 : G` be two elements.  `unique_mul A B a0 b0` asserts `a0 * b0` can be written in at
most one way as a product of an element of `A` and an element of `B`. -/
@[to_additive "Let `G` be a Type with addition, let `A B : finset G` be finite subsets and
let `a0 b0 : G` be two elements.  `unique_add A B a0 b0` asserts `a0 + b0` can be written in at
most one way as a sum of an element from `A` and an element from `B`."]
def unique_mul {G} [has_mul G] (A B : finset G) (a0 b0 : G) : Prop :=
∀ ⦃a b⦄, a ∈ A → b ∈ B → a * b = a0 * b0 → a = a0 ∧ b = b0

namespace unique_mul
variables {G H : Type*} [has_mul G] [has_mul H] {A B : finset G} {a0 b0 : G}

lemma mt {G} [has_mul G] {A B : finset G} {a0 b0 : G} (h : unique_mul A B a0 b0) :
  ∀ ⦃a b⦄, a ∈ A → b ∈ B → a ≠ a0 ∨ b ≠ b0 → a * b ≠ a0 * b0 :=
λ _ _ ha hb k, by { contrapose! k, exact h ha hb k }

@[to_additive]

@[to_additive]
lemma set_subsingleton (A B : finset G) (a0 b0 : G) (h : unique_mul A B a0 b0) :
  set.subsingleton { ab : G × G | ab.1 ∈ A ∧ ab.2 ∈ B ∧ ab.1 * ab.2 = a0 * b0 } :=
begin
  rintros ⟨x1, y1⟩ (hx : x1 ∈ A ∧ y1 ∈ B ∧ x1 * y1 = a0 * b0)
          ⟨x2, y2⟩ (hy : x2 ∈ A ∧ y2 ∈ B ∧ x2 * y2 = a0 * b0),
  rcases h hx.1 hx.2.1 hx.2.2 with ⟨rfl, rfl⟩,
  rcases h hy.1 hy.2.1 hy.2.2 with ⟨rfl, rfl⟩,
  refl,
end

@[to_additive]
lemma iff_exists_unique (aA : a0 ∈ A) (bB : b0 ∈ B) :
  unique_mul A B a0 b0 ↔ ∃! ab ∈ A ×ˢ B, ab.1 * ab.2 = a0 * b0 :=
⟨λ _, ⟨(a0, b0), ⟨finset.mem_product.mpr ⟨aA, bB⟩, rfl, by simp⟩, by simpa⟩, λ h, h.elim2 begin
  rintro ⟨x1, x2⟩ _ _ J x y hx hy l,
  rcases prod.mk.inj_iff.mp (J (a0,b0) (finset.mk_mem_product aA bB) rfl) with ⟨rfl, rfl⟩,
  exact prod.mk.inj_iff.mp (J (x,y) (finset.mk_mem_product hx hy) l),
end⟩

@[to_additive]
lemma exists_iff_exists_exists_unique : (∃ a0 b0 : G, a0 ∈ A ∧ b0 ∈ B ∧ unique_mul A B a0 b0) ↔
  ∃ g : G, ∃! ab ∈ A ×ˢ B, ab.1 * ab.2 = g :=
⟨λ ⟨a0, b0, hA, hB, h⟩, ⟨_, (iff_exists_unique hA hB).mp h⟩, λ ⟨g, h⟩, begin
    have h' := h,
    rcases h' with ⟨⟨a,b⟩, ⟨hab, rfl, -⟩, -⟩,
    cases finset.mem_product.mp hab with ha hb,
    exact ⟨a, b, ha, hb, (iff_exists_unique ha hb).mpr h⟩,
  end⟩

/--  `unique_mul` is preserved by inverse images under injective, multiplicative maps. -/
@[to_additive "`unique_add` is preserved by inverse images under injective, additive maps."]
lemma mul_hom_preimage (f : G →ₙ* H) (hf : function.injective f) (a0 b0 : G) {A B : finset H}
  (u : unique_mul A B (f a0) (f b0)) :
  unique_mul (A.preimage f (set.inj_on_of_injective hf _))
    (B.preimage f (set.inj_on_of_injective hf _)) a0 b0 :=
begin
  intros a b ha hb ab,
  rw [← hf.eq_iff, ← hf.eq_iff],
  rw [← hf.eq_iff, map_mul, map_mul] at ab,
  exact u (finset.mem_preimage.mp ha) (finset.mem_preimage.mp hb) ab,
end

/--  `unique_mul` is preserved under multiplicative maps that are injective.

See `unique_mul.mul_hom_map_iff` for a version with swapped bundling. -/
@[to_additive "`unique_add` is preserved under additive maps that are injective.

See `unique_add.add_hom_map_iff` for a version with swapped bundling."]
lemma mul_hom_image_iff [decidable_eq H] (f : G →ₙ* H) (hf : function.injective f) :
  unique_mul (A.image f) (B.image f) (f a0) (f b0) ↔ unique_mul A B a0 b0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { intros a b ha hb ab,
    rw [← hf.eq_iff, ← hf.eq_iff],
    rw [← hf.eq_iff, map_mul, map_mul] at ab,
    exact h (finset.mem_image.mpr ⟨_, ha, rfl⟩) (finset.mem_image.mpr ⟨_, hb, rfl⟩) ab},
  { intros a b aA bB ab,
    obtain ⟨a, ha, rfl⟩ : ∃ a' ∈ A, f a' = a := finset.mem_image.mp aA,
    obtain ⟨b, hb, rfl⟩ : ∃ b' ∈ B, f b' = b := finset.mem_image.mp bB,
    rw [hf.eq_iff, hf.eq_iff],
    rw [← map_mul, ← map_mul, hf.eq_iff] at ab,
    exact h ha hb ab },
end

/--  `unique_mul` is preserved under embeddings that are multiplicative.

See `unique_mul.mul_hom_image_iff` for a version with swapped bundling. -/
@[to_additive "`unique_add` is preserved under embeddings that are additive.

See `unique_add.add_hom_image_iff` for a version with swapped bundling."]
lemma mul_hom_map_iff (f : G ↪ H) (mul : ∀ x y, f (x * y) = f x * f y) :
  unique_mul (A.map f) (B.map f) (f a0) (f b0) ↔ unique_mul A B a0 b0 :=
begin
  classical,
  convert mul_hom_image_iff ⟨f, mul⟩ f.2;
  { ext,
    simp only [finset.mem_map, mul_hom.coe_mk, finset.mem_image] },
end

end unique_mul

/--  Let `G` be a Type with addition.  `unique_sums G` asserts that any two non-empty
finite subsets of `A` have the `unique_add` property, with respect to some element of their
sum `A + B`. -/
class unique_sums (G) [has_add G] : Prop :=
(unique_add_of_nonempty : ∀ {A B : finset G} (hA : A.nonempty) (hB : B.nonempty),
  ∃ (a0 ∈ A) (b0 ∈ B), unique_add A B a0 b0)

/--  Let `G` be a Type with multiplication.  `unique_prods G` asserts that any two non-empty
finite subsets of `G` have the `unique_mul` property, with respect to some element of their
product `A * B`. -/
class unique_prods (G) [has_mul G] : Prop :=
(unique_mul_of_nonempty : ∀ {A B : finset G} (hA : A.nonempty) (hB : B.nonempty),
  ∃ (a0 ∈ A) (b0 ∈ B), unique_mul A B a0 b0)

attribute [to_additive] unique_prods

namespace multiplicative

instance {M} [has_add M] [unique_sums M] : unique_prods (multiplicative M) :=
{ unique_mul_of_nonempty := λ A B hA hB, let A' : finset M := A in have hA': A'.nonempty := hA, by
    { obtain ⟨a0, hA0, b0, hB0, J⟩ := unique_sums.unique_add_of_nonempty hA' hB,
      exact ⟨of_add a0, hA0, of_add b0, hB0, λ a b aA bB H, J aA bB H⟩ } }

end multiplicative

namespace additive

instance {M} [has_mul M] [unique_prods M] : unique_sums (additive M) :=
{ unique_add_of_nonempty := λ A B hA hB, let A' : finset M := A in have hA': A'.nonempty := hA, by
    { obtain ⟨a0, hA0, b0, hB0, J⟩ := unique_prods.unique_mul_of_nonempty hA' hB,
      exact ⟨of_mul a0, hA0, of_mul b0, hB0, λ a b aA bB H, J aA bB H⟩ } }

end additive

@[to_additive] lemma eq_and_eq_of_le_of_le_of_mul_le {A} [has_mul A] [linear_order A]
  [covariant_class A A (*) (≤)] [covariant_class A A (function.swap (*)) (<)]
  [contravariant_class A A (*) (≤)]
  {a b a0 b0 : A} (ha : a0 ≤ a) (hb : b0 ≤ b) (ab : a * b ≤ a0 * b0) :
  a = a0 ∧ b = b0 :=
begin
  haveI := has_mul.to_covariant_class_right A,
  have ha' : ¬a0 * b0 < a * b → ¬a0 < a := mt (λ h, mul_lt_mul_of_lt_of_le h hb),
  have hb' : ¬a0 * b0 < a * b → ¬b0 < b := mt (λ h, mul_lt_mul_of_le_of_lt ha h),
  push_neg at ha' hb',
  exact ⟨ha.antisymm' (ha' ab), hb.antisymm' (hb' ab)⟩,
end

/--  This instance asserts that if `A` has a multiplication, a linear order, and multiplication
is 'very monotone', then `A` also has `unique_prods`. -/
@[priority 100,  -- see Note [lower instance priority]
to_additive "This instance asserts that if `A` has an addition, a linear order, and addition
is 'very monotone', then `A` also has `unique_sums`."]
instance covariants.to_unique_prods {A} [has_mul A] [linear_order A]
  [covariant_class A A (*) (≤)] [covariant_class A A (function.swap (*)) (<)]
  [contravariant_class A A (*) (≤)] : unique_prods A :=
{ unique_mul_of_nonempty := λ A B hA hB, ⟨_, A.min'_mem ‹_›, _, B.min'_mem ‹_›, λ a b ha hb ab,
    eq_and_eq_of_le_of_le_of_mul_le (finset.min'_le _ _ ‹_›) (finset.min'_le _ _ ‹_›) ab.le⟩ }


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Kexing Ying, Eric Wieser
-/
import linear_algebra.quadratic_form.basic
import analysis.special_functions.pow
import data.real.sign

/-!
# Real quadratic forms

Sylvester's law of inertia `equivalent_one_neg_one_weighted_sum_squared`:
A real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1 or 0.

When the real quadratic form is nondegerate we can take the weights to be ±1,
as in `equivalent_one_zero_neg_one_weighted_sum_squared`.

-/

namespace quadratic_form

open_locale big_operators
open real finset

variables {ι : Type*} [fintype ι]

/-- The isometry between a weighted sum of squares with weights `u` on the
(non-zero) real numbers and the weighted sum of squares with weights `sign ∘ u`. -/
noncomputable def isometry_sign_weighted_sum_squares
  [decidable_eq ι] (w : ι → ℝ) :
  isometry (weighted_sum_squares ℝ w) (weighted_sum_squares ℝ (sign ∘ w)) :=
begin
  let u := λ i, if h : w i = 0 then (1 : units ℝ) else units.mk0 (w i) h,
  have hu' : ∀ i : ι, (sign (u i) * u i) ^ - (1 / 2 : ℝ) ≠ 0,
  { intro i, refine (ne_of_lt (real.rpow_pos_of_pos
      (sign_mul_pos_of_ne_zero _ $ units.ne_zero _) _)).symm},
  convert ((weighted_sum_squares ℝ w).isometry_basis_repr
    ((pi.basis_fun ℝ ι).units_smul (λ i, (is_unit_iff_ne_zero.2 $ hu' i).unit))),
  ext1 v,
  rw [basis_repr_apply, weighted_sum_squares_apply, weighted_sum_squares_apply],
  refine sum_congr rfl (λ j hj, _),
  have hsum : (∑ (i : ι), v i • ((is_unit_iff_ne_zero.2 $ hu' i).unit : ℝ) •
    (pi.basis_fun ℝ ι) i) j = v j • (sign (u j) * u j) ^ - (1 / 2 : ℝ),
  { rw [finset.sum_apply, sum_eq_single j, pi.basis_fun_apply, is_unit.unit_spec,
        linear_map.std_basis_apply, pi.smul_apply, pi.smul_apply, function.update_same,
        smul_eq_mul, smul_eq_mul, smul_eq_mul, mul_one],
    intros i _ hij,
    rw [pi.basis_fun_apply, linear_map.std_basis_apply, pi.smul_apply, pi.smul_apply,
        function.update_noteq hij.symm, pi.zero_apply, smul_eq_mul, smul_eq_mul,
        mul_zero, mul_zero],
    intro hj', exact false.elim (hj' hj) },
  simp_rw basis.units_smul_apply,
  erw [hsum],
  simp only [u, function.comp, smul_eq_mul],
  split_ifs,
  { simp only [h, zero_smul, zero_mul, sign_zero] },
  have hwu : w j = u j,
  { simp only [u, dif_neg h, units.coe_mk0] },
  simp only [hwu, units.coe_mk0],
  suffices : (u j : ℝ).sign * v j * v j = (sign (u j) * u j) ^ - (1 / 2 : ℝ) *
    (sign (u j) * u j) ^ - (1 / 2 : ℝ) * u j * v j * v j,
  { erw [← mul_assoc, this], ring },
  rw [← real.rpow_add (sign_mul_pos_of_ne_zero _ $ units.ne_zero _),
      show - (1 / 2 : ℝ) + - (1 / 2) = -1, by ring, real.rpow_neg_one, mul_inv₀,
      inv_sign, mul_assoc (sign (u j)) (u j)⁻¹,
      inv_mul_cancel (units.ne_zero _), mul_one],
  apply_instance
end

/-- **Sylvester's law of inertia**: A nondegenerate real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1. -/
theorem equivalent_one_neg_one_weighted_sum_squared
  {M : Type*} [add_comm_group M] [module ℝ M] [finite_dimensional ℝ M]
  (Q : quadratic_form ℝ M) (hQ : (associated Q).nondegenerate) :
  ∃ w : fin (finite_dimensional.finrank ℝ M) → ℝ,
  (∀ i, w i = -1 ∨ w i = 1) ∧ equivalent Q (weighted_sum_squares ℝ w) :=
let ⟨w, ⟨hw₁⟩⟩ := Q.equivalent_weighted_sum_squares_units_of_nondegenerate' hQ in
  ⟨sign ∘ coe ∘ w,
   λ i, sign_apply_eq_of_ne_zero (w i) (w i).ne_zero,
   ⟨hw₁.trans (isometry_sign_weighted_sum_squares (coe ∘ w))⟩⟩

/-- **Sylvester's law of inertia**: A real quadratic form is equivalent to a weighted
sum of squares with the weights being ±1 or 0. -/
theorem equivalent_one_zero_neg_one_weighted_sum_squared
  {M : Type*} [add_comm_group M] [module ℝ M] [finite_dimensional ℝ M]
  (Q : quadratic_form ℝ M) :
  ∃ w : fin (finite_dimensional.finrank ℝ M) → ℝ,
  (∀ i, w i = -1 ∨ w i = 0 ∨ w i = 1) ∧ equivalent Q (weighted_sum_squares ℝ w) :=
let ⟨w, ⟨hw₁⟩⟩ := Q.equivalent_weighted_sum_squares in
  ⟨sign ∘ coe ∘ w,
   λ i, sign_apply_eq (w i),
   ⟨hw₁.trans (isometry_sign_weighted_sum_squares w)⟩⟩

end quadratic_form


-- 4.5 More on the Proof Language

variable f : ℕ → ℕ
variable h : ∀ x : ℕ, f x ≤ f (x + 1)

example : f 0 ≤ f 3 :=
have f 0 ≤ f 1, from h 0,
have f 0 ≤ f 2, from le_trans this (h 1),
show f 0 ≤ f 3, from le_trans this (h 2)

example : f 0 ≤ f 3 :=
have f 0 ≤ f 1, from h 0,
have f 0 ≤ f 2, from le_trans (by assumption) (h 1),
show f 0 ≤ f 3, from le_trans (by assumption) (h 2)

example : f 0 ≥ f 1 → f 1 ≥ f 2 → f 0 = f 2 :=
assume : f 0 ≥ f 1,
assume : f 1 ≥ f 2,
have f 0 ≥ f 2, from le_trans this ‹ f 0 ≥ f 1 ›,
have f 0 ≤ f 2, from le_trans (h 0) (h 1),
show f 0 = f 2, from le_antisymm this ‹ f 0 ≥ f 2 ›

example : f 0 ≤ f 3 :=
have f 0 ≤ f 1, from h 0,
have f 1 ≤ f 2, from h 1,
have f 2 ≤ f 3, from h 2,
show f 0 ≤ f 3, from le_trans ‹ f 0 ≤ f 1 › (le_trans ‹ f 1 ≤ f 2 › ‹ f 2 ≤ f 3 › )

example (n : ℕ) : ℕ := ‹ℕ›

example : f 0 ≥ f 1 → f 0 = f 1 :=
assume : f 0 ≥ f 1,
show f 0 = f 1, from le_antisymm (h 0) this

example : f 0 ≥ f 1 → f 1 ≥ f 2 → f 0 = f 2 :=
assume : f 0 ≥ f 1,
assume : f 1 ≥ f 2,
have f 0 ≥ f 2, from le_trans ‹f 2 ≤ f 1› ‹f 1 ≤ f 0›,
have f 0 ≤ f 2, from le_trans (h 0) (h 1),
show f 0 = f 2, from le_antisymm this ‹f 0 ≥ f 2›


import order.lattice data.finset
universes u v w

noncomputable theory

open classical set function lattice

instance {α : Type u} [semilattice_sup α] : is_idempotent α (⊔) := ⟨assume a, sup_idem⟩

namespace finset
section general

variables {α : Type u} {β : Type w} [decidable_eq β] [semilattice_sup_bot α]

def Sup_fin (s : finset β) (f : β → α) : α := s.fold (⊔) ⊥ f

variables {s s₁ s₂ : finset β} {f : β → α}

@[simp] lemma Sup_fin_empty : (∅ : finset β).Sup_fin f = ⊥ :=
fold_empty

@[simp] lemma Sup_fin_insert {b : β} : (insert b s : finset β).Sup_fin f = f b ⊔ s.Sup_fin f :=
fold_insert_idem

@[simp] lemma Sup_fin_singleton {b : β} : (finset.singleton b).Sup_fin f = f b :=
calc _ = f b ⊔ (∅:finset β).Sup_fin f : Sup_fin_insert
  ... = f b : by simp

lemma Sup_fin_union : (s₁ ∪ s₂).Sup_fin f = s₁.Sup_fin f ⊔ s₂.Sup_fin f :=
finset.induction_on s₁ (by simp) (by simp {contextual := tt}; cc)

lemma Sup_fin_mono_fun {g : β → α} : (∀b∈s, f b ≤ g b) → s.Sup_fin f ≤ s.Sup_fin g :=
finset.induction_on s (by simp) (by simp [-sup_le_iff, sup_le_sup] {contextual := tt})

lemma le_Sup_fin {b : β} (hb : b ∈ s) : f b ≤ s.Sup_fin f :=
calc f b ≤ f b ⊔ s.Sup_fin f : le_sup_left
  ... = (insert b s).Sup_fin f : by simp
  ... = s.Sup_fin f : by simp [hb]

lemma Sup_fin_le {a : α} : (∀b ∈ s, f b ≤ a) → s.Sup_fin f ≤ a :=
finset.induction_on s (by simp) (by simp {contextual := tt})

lemma Sup_fin_mono (h : s₁ ⊆ s₂) : s₁.Sup_fin f ≤ s₂.Sup_fin f :=
Sup_fin_le $ assume b hb, le_Sup_fin (finset.subset_iff.mpr h hb)

end general

end finset

instance nat.distrib_lattice : distrib_lattice ℕ :=
by apply_instance

instance nat.semilattice_sup_bot : semilattice_sup_bot ℕ :=
{ bot := 0, bot_le := nat.zero_le , .. nat.distrib_lattice }

lemma nat.sup_eq_max {n m : ℕ} : n ⊔ m = max n m := rfl

lemma forall_eq_zero_of_sup_fin_eq_bot {s : finset ℕ} : finset.Sup_fin s id = 0 → ∀x ∈ s, x = 0 :=
begin
  intros h x h2,
  have : x ≤ 0,
  exact calc x = id x : rfl
  ... ≤ finset.Sup_fin s id : finset.le_Sup_fin h2
  ... = 0 : h,
  exact nat.eq_zero_of_le_zero this
end

lemma eq_singleton_or_eq_empty_of_sup_fin_eq_bot {s : finset ℕ} : finset.Sup_fin s id = 0 → s = {0} ∨ s = ∅ :=
begin
  intro h,
  by_cases h1 : (s = ∅),
  simp [h1],
  have h2 : ∀x ∈ s, x = 0,
  from forall_eq_zero_of_sup_fin_eq_bot h,
  have hex : ∃x : ℕ, x ∈ s,
  from  finset.exists_mem_of_ne_empty h1,
  have h3: {0} ⊆ s,
  have h4 : (some hex) ∈ s,
  from some_spec hex,
  have h5: (some hex) = 0,
  from h2 (some hex) h4,
  have h6: 0 ∈ s,
  rw [←h5],
  exact h4,
  exact iff.elim_right singleton_subset_iff h6,
  have h7 : s ⊆ {0},
  dunfold has_subset.subset,
  intros a h4,
  have h8 : a = 0,
  from h2 a h4,
  rw h8,
  exact mem_singleton 0,
  have h9 : s = {0},
  exact finset.subset.antisymm h7 h3,
  simp [h9]
end

open finset
lemma Sup_fin_mem_of_id_nat {s : finset ℕ} : s ≠ ∅ → Sup_fin s id ∈ s :=
finset.induction_on s
  (by contradiction)
  (by intros a s; by_cases s = ∅; cases le_total a (Sup_fin s id);
      simp [*, nat.sup_eq_max, max_eq_left, max_eq_right] {contextual := tt})


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kenny Lau, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.basic
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Eckmann-Hilton argument

The Eckmann-Hilton argument says that if a type carries two monoid structures that distribute
over one another, then they are equal, and in addition commutative.
The main application lies in proving that higher homotopy groups (`πₙ` for `n ≥ 2`) are commutative.

## Main declarations

* `eckmann_hilton.comm_monoid`: If a type carries two unital binary operations that distribute
  over each other, then these operations are equal, and form a commutative monoid structure.
* `eckmann_hilton.comm_group`: If a type carries a group structure that distributes
  over a unital binary operation, then the group is commutative.

-/

namespace eckmann_hilton

/-- `is_unital m e` expresses that `e : X` is a left and right unit
for the binary operation `m : X → X → X`. -/
class is_unital {X : Type u} (m : X → X → X) (e : X) where
  one_mul : ∀ (x : X), m e x = x
  mul_one : ∀ (x : X), m x e = x

theorem Mathlib.add_group.is_unital {X : Type u} [G : add_group X] : is_unital Add.add 0 :=
  is_unital.mk add_group.zero_add add_group.add_zero

/-- If a type carries two unital binary operations that distribute over each other,
then they have the same unit elements.

In fact, the two operations are the same, and give a commutative monoid structure,
see `eckmann_hilton.comm_monoid`. -/
theorem one {X : Type u} {m₁ : X → X → X} {m₂ : X → X → X} {e₁ : X} {e₂ : X} (h₁ : is_unital m₁ e₁)
    (h₂ : is_unital m₂ e₂)
    (distrib : ∀ (a b c d : X), m₁ (m₂ a b) (m₂ c d) = m₂ (m₁ a c) (m₁ b d)) : e₁ = e₂ :=
  sorry

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are equal.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
theorem mul {X : Type u} {m₁ : X → X → X} {m₂ : X → X → X} {e₁ : X} {e₂ : X} (h₁ : is_unital m₁ e₁)
    (h₂ : is_unital m₂ e₂)
    (distrib : ∀ (a b c d : X), m₁ (m₂ a b) (m₂ c d) = m₂ (m₁ a c) (m₁ b d)) : m₁ = m₂ :=
  sorry

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are commutative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
theorem mul_comm {X : Type u} {m₁ : X → X → X} {m₂ : X → X → X} {e₁ : X} {e₂ : X}
    (h₁ : is_unital m₁ e₁) (h₂ : is_unital m₂ e₂)
    (distrib : ∀ (a b c d : X), m₁ (m₂ a b) (m₂ c d) = m₂ (m₁ a c) (m₁ b d)) :
    is_commutative X m₂ :=
  sorry

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are associative.

In fact, they give a commutative monoid structure, see `eckmann_hilton.comm_monoid`. -/
theorem mul_assoc {X : Type u} {m₁ : X → X → X} {m₂ : X → X → X} {e₁ : X} {e₂ : X}
    (h₁ : is_unital m₁ e₁) (h₂ : is_unital m₂ e₂)
    (distrib : ∀ (a b c d : X), m₁ (m₂ a b) (m₂ c d) = m₂ (m₁ a c) (m₁ b d)) :
    is_associative X m₂ :=
  sorry

/-- If a type carries two unital binary operations that distribute over each other,
then these operations are equal, and form a commutative monoid structure. -/
def comm_monoid {X : Type u} {m₁ : X → X → X} {m₂ : X → X → X} {e₁ : X} {e₂ : X}
    (h₁ : is_unital m₁ e₁) (h₂ : is_unital m₂ e₂)
    (distrib : ∀ (a b c d : X), m₁ (m₂ a b) (m₂ c d) = m₂ (m₁ a c) (m₁ b d)) : comm_monoid X :=
  comm_monoid.mk m₂ sorry e₂ is_unital.one_mul is_unital.mul_one sorry

/-- If a type carries a group structure that distributes over a unital binary operation,
then the group is commutative. -/
def comm_group {X : Type u} {m₁ : X → X → X} {e₁ : X} (h₁ : is_unital m₁ e₁) [G : group X]
    (distrib : ∀ (a b c d : X), m₁ (a * b) (c * d) = m₁ a c * m₁ b d) : comm_group X :=
  comm_group.mk group.mul group.mul_assoc group.one group.one_mul group.mul_one group.inv group.div
    group.mul_left_inv sorry

end Mathlib


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/

import set_theory.game.basic
import tactic.nth_rewrite.default

/-!
# Basic definitions about impartial (pre-)games

We will define an impartial game, one in which left and right can make exactly the same moves.
Our definition differs slightly by saying that the game is always equivalent to its negative,
no matter what moves are played. This allows for games such as poker-nim to be classifed as
impartial.
-/

universe u

open_locale pgame

namespace pgame

/-- The definition for a impartial game, defined using Conway induction. -/
def impartial_aux : pgame → Prop
| G := G ≈ -G ∧ (∀ i, impartial_aux (G.move_left i)) ∧ ∀ j, impartial_aux (G.move_right j)
using_well_founded { dec_tac := pgame_wf_tac }

lemma impartial_aux_def {G : pgame} : G.impartial_aux ↔ G ≈ -G ∧
  (∀ i, impartial_aux (G.move_left i)) ∧ ∀ j, impartial_aux (G.move_right j) :=
by rw impartial_aux

/-- A typeclass on impartial games. -/
class impartial (G : pgame) : Prop := (out : impartial_aux G)

lemma impartial_iff_aux {G : pgame} : G.impartial ↔ G.impartial_aux :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

lemma impartial_def {G : pgame} : G.impartial ↔ G ≈ -G ∧
  (∀ i, impartial (G.move_left i)) ∧ ∀ j, impartial (G.move_right j) :=
by simpa only [impartial_iff_aux] using impartial_aux_def

namespace impartial

instance impartial_zero : impartial 0 :=
by { rw impartial_def, dsimp, simp }

instance impartial_star : impartial star :=
by { rw impartial_def, simpa using impartial.impartial_zero }

lemma neg_equiv_self (G : pgame) [h : G.impartial] : G ≈ -G := (impartial_def.1 h).1

@[simp] lemma mk_neg_equiv_self (G : pgame) [h : G.impartial] : -⟦G⟧ = ⟦G⟧ :=
quot.sound (neg_equiv_self G).symm

instance move_left_impartial {G : pgame} [h : G.impartial] (i : G.left_moves) :
  (G.move_left i).impartial :=
(impartial_def.1 h).2.1 i

instance move_right_impartial {G : pgame} [h : G.impartial] (j : G.right_moves) :
  (G.move_right j).impartial :=
(impartial_def.1 h).2.2 j

theorem impartial_congr : ∀ {G H : pgame} (e : G ≡r H) [G.impartial], H.impartial
| G H e := begin
  introI h,
  rw impartial_def,
  refine ⟨e.symm.equiv.trans ((neg_equiv_self G).trans (neg_equiv_neg_iff.2 e.equiv)),
    λ i, _, λ j, _⟩;
  cases e with _ _ L R hL hR,
  { convert impartial_congr (hL (L.symm i)),
    rw equiv.apply_symm_apply },
  { exact impartial_congr (hR j) }
end
using_well_founded { dec_tac := pgame_wf_tac }

instance impartial_add : ∀ (G H : pgame) [G.impartial] [H.impartial], (G + H).impartial
| G H :=
begin
  introsI hG hH,
  rw impartial_def,
  refine ⟨(add_congr (neg_equiv_self _) (neg_equiv_self _)).trans
    (neg_add_relabelling _ _).equiv.symm, λ k, _, λ k, _⟩,
  { apply left_moves_add_cases k,
    all_goals
    { intro i, simp only [add_move_left_inl, add_move_left_inr],
      apply impartial_add } },
  { apply right_moves_add_cases k,
    all_goals
    { intro i, simp only [add_move_right_inl, add_move_right_inr],
      apply impartial_add } }
end
using_well_founded { dec_tac := pgame_wf_tac }

instance impartial_neg : ∀ (G : pgame) [G.impartial], (-G).impartial
| G :=
begin
  introI hG,
  rw impartial_def,
  refine ⟨_, λ i, _, λ i, _⟩,
  { rw neg_neg,
    exact (neg_equiv_self G).symm },
  { rw move_left_neg',
    apply impartial_neg },
  { rw move_right_neg',
    apply impartial_neg }
end
using_well_founded { dec_tac := pgame_wf_tac }

variables (G : pgame) [impartial G]

lemma nonpos : ¬ 0 < G :=
λ h, begin
  have h' := neg_lt_neg_iff.2 h,
  rw [pgame.neg_zero, lt_congr_left (neg_equiv_self G).symm] at h',
  exact (h.trans h').false
end

lemma nonneg : ¬ G < 0 :=
λ h, begin
  have h' := neg_lt_neg_iff.2 h,
  rw [pgame.neg_zero, lt_congr_right (neg_equiv_self G).symm] at h',
  exact (h.trans h').false
end

/-- In an impartial game, either the first player always wins, or the second player always wins. -/
lemma equiv_or_fuzzy_zero : G ≈ 0 ∨ G ∥ 0 :=
begin
  rcases lt_or_equiv_or_gt_or_fuzzy G 0 with h | h | h | h,
  { exact ((nonneg G) h).elim },
  { exact or.inl h },
  { exact ((nonpos G) h).elim },
  { exact or.inr h }
end

@[simp] lemma not_equiv_zero_iff : ¬ G ≈ 0 ↔ G ∥ 0 :=
⟨(equiv_or_fuzzy_zero G).resolve_left, fuzzy.not_equiv⟩

@[simp] lemma not_fuzzy_zero_iff : ¬ G ∥ 0 ↔ G ≈ 0 :=
⟨(equiv_or_fuzzy_zero G).resolve_right, equiv.not_fuzzy⟩

lemma add_self : G + G ≈ 0 :=
(add_congr_left (neg_equiv_self G)).trans (add_left_neg_equiv G)

@[simp] lemma mk_add_self : ⟦G⟧ + ⟦G⟧ = 0 := quot.sound (add_self G)

/-- This lemma doesn't require `H` to be impartial. -/
lemma equiv_iff_add_equiv_zero (H : pgame) : H ≈ G ↔ H + G ≈ 0 :=
by { rw [equiv_iff_game_eq, equiv_iff_game_eq, ←@add_right_cancel_iff _ _ (-⟦G⟧)], simpa }

/-- This lemma doesn't require `H` to be impartial. -/
lemma equiv_iff_add_equiv_zero' (H : pgame) : G ≈ H ↔ G + H ≈ 0 :=
by { rw [equiv_iff_game_eq, equiv_iff_game_eq, ←@add_left_cancel_iff _ _ (-⟦G⟧), eq_comm], simpa }

lemma le_zero_iff {G : pgame} [G.impartial] : G ≤ 0 ↔ 0 ≤ G :=
by rw [←zero_le_neg_iff, le_congr_right (neg_equiv_self G)]

lemma equiv_zero_iff_le: G ≈ 0 ↔ G ≤ 0 := ⟨and.left, λ h, ⟨h, le_zero_iff.1 h⟩⟩
lemma fuzzy_zero_iff_lf : G ∥ 0 ↔ G ⧏ 0 := ⟨and.left, λ h, ⟨h, lf_zero_iff.1 h⟩⟩
lemma equiv_zero_iff_ge : G ≈ 0 ↔ 0 ≤ G := ⟨and.right, λ h, ⟨le_zero_iff.2 h, h⟩⟩
lemma fuzzy_zero_iff_gf : G ∥ 0 ↔ 0 ⧏ G := ⟨and.right, λ h, ⟨lf_zero_iff.2 h, h⟩⟩

lemma forall_left_moves_fuzzy_iff_equiv_zero : (∀ i, G.move_left i ∥ 0) ↔ G ≈ 0 :=
begin
  refine ⟨λ hb, _, λ hp i, _⟩,
  { rw [equiv_zero_iff_le G, le_zero_lf],
    exact λ i, (hb i).1 },
  { rw fuzzy_zero_iff_lf,
    exact move_left_lf_of_le i hp.1 }
end

lemma forall_right_moves_fuzzy_iff_equiv_zero : (∀ j, G.move_right j ∥ 0) ↔ G ≈ 0 :=
begin
  refine ⟨λ hb, _, λ hp i, _⟩,
  { rw [equiv_zero_iff_ge G, zero_le_lf],
    exact λ i, (hb i).2 },
  { rw fuzzy_zero_iff_gf,
    exact lf_move_right_of_le i hp.2 }
end

lemma exists_left_move_equiv_iff_fuzzy_zero : (∃ i, G.move_left i ≈ 0) ↔ G ∥ 0 :=
begin
  refine ⟨λ ⟨i, hi⟩, (fuzzy_zero_iff_gf G).2 (lf_of_le_move_left hi.2), λ hn, _⟩,
  rw [fuzzy_zero_iff_gf G, zero_lf_le] at hn,
  cases hn with i hi,
  exact ⟨i, (equiv_zero_iff_ge _).2 hi⟩
end

lemma exists_right_move_equiv_iff_fuzzy_zero : (∃ j, G.move_right j ≈ 0) ↔ G ∥ 0 :=
begin
  refine ⟨λ ⟨i, hi⟩, (fuzzy_zero_iff_lf G).2 (lf_of_move_right_le hi.1), λ hn, _⟩,
  rw [fuzzy_zero_iff_lf G, lf_zero_le] at hn,
  cases hn with i hi,
  exact ⟨i, (equiv_zero_iff_le _).2 hi⟩
end

end impartial
end pgame


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot

! This file was ported from Lean 3 source module topology.uniform_space.absolute_value
! leanprover-community/mathlib commit e1a7bdeb4fd826b7e71d130d34988f0a2d26a177
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.AbsoluteValue
import Mathlib.Topology.UniformSpace.Basic

/-!
# Uniform structure induced by an absolute value

We build a uniform space structure on a commutative ring `R` equipped with an absolute value into
a linear ordered field `𝕜`. Of course in the case `R` is `ℚ`, `ℝ` or `ℂ` and
`𝕜 = ℝ`, we get the same thing as the metric space construction, and the general construction
follows exactly the same path.

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

absolute value, uniform spaces
-/

open Set Function Filter Topology

namespace AbsoluteValue

variable {𝕜 : Type _} [LinearOrderedField 𝕜]
variable {R : Type _} [CommRing R] (abv : AbsoluteValue R 𝕜)

/-- The uniform structure coming from an absolute value. -/
def uniformSpace : UniformSpace R :=
  .ofFun (fun x y => abv (y - x)) (by simp) (fun x y => abv.map_sub y x)
    (fun x y z => (abv.sub_le _ _ _).trans_eq (add_comm _ _))
    fun ε ε0 => ⟨ε / 2, half_pos ε0, fun _ h₁ _ h₂ => (add_lt_add h₁ h₂).trans_eq (add_halves ε)⟩
#align absolute_value.uniform_space AbsoluteValue.uniformSpace

theorem hasBasis_uniformity :
    𝓤[abv.uniformSpace].HasBasis ((0 : 𝕜) < ·) fun ε => { p : R × R | abv (p.2 - p.1) < ε } :=
  UniformSpace.hasBasis_ofFun (exists_gt _) _ _ _ _ _
#align absolute_value.has_basis_uniformity AbsoluteValue.hasBasis_uniformity

end AbsoluteValue


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov, Heather Macbeth

! This file was ported from Lean 3 source module measure_theory.function.simple_func_dense
! 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.MeasureTheory.Integral.Lebesgue

/-!
# Density of simple functions

Show that each Borel measurable function can be approximated pointwise
by a sequence of simple functions.

## Main definitions

* `measure_theory.simple_func.nearest_pt (e : ℕ → α) (N : ℕ) : α →ₛ ℕ`: the `simple_func` sending
  each `x : α` to the point `e k` which is the nearest to `x` among `e 0`, ..., `e N`.
* `measure_theory.simple_func.approx_on (f : β → α) (hf : measurable f) (s : set α) (y₀ : α)
  (h₀ : y₀ ∈ s) [separable_space s] (n : ℕ) : β →ₛ α` : a simple function that takes values in `s`
  and approximates `f`.

## Main results

* `tendsto_approx_on` (pointwise convergence): If `f x ∈ s`, then the sequence of simple
  approximations `measure_theory.simple_func.approx_on f hf s y₀ h₀ n`, evaluated at `x`,
  tends to `f x` as `n` tends to `∞`.

## Notations

* `α →ₛ β` (local notation): the type of simple functions `α → β`.
-/

open Set Function Filter TopologicalSpace ENNReal Emetric Finset

open Classical Topology ENNReal MeasureTheory BigOperators

variable {α β ι E F 𝕜 : Type _}

noncomputable section

namespace MeasureTheory

-- mathport name: «expr →ₛ »
local infixr:25 " →ₛ " => SimpleFunc

namespace SimpleFunc

/-! ### Pointwise approximation by simple functions -/

variable [MeasurableSpace α] [PseudoEMetricSpace α] [OpensMeasurableSpace α]

/-- `nearest_pt_ind e N x` is the index `k` such that `e k` is the nearest point to `x` among the
points `e 0`, ..., `e N`. If more than one point are at the same distance from `x`, then
`nearest_pt_ind e N x` returns the least of their indexes. -/
noncomputable def nearestPtInd (e : ℕ → α) : ℕ → α →ₛ ℕ
  | 0 => const α 0
  | N + 1 =>
    piecewise (⋂ k ≤ N, { x | edist (e (N + 1)) x < edist (e k) x })
      (MeasurableSet.interᵢ fun k =>
        MeasurableSet.interᵢ fun hk =>
          measurableSet_lt measurable_edist_right measurable_edist_right)
      (const α <| N + 1) (nearest_pt_ind N)
#align measure_theory.simple_func.nearest_pt_ind MeasureTheory.SimpleFunc.nearestPtInd

/-- `nearest_pt e N x` is the nearest point to `x` among the points `e 0`, ..., `e N`. If more than
one point are at the same distance from `x`, then `nearest_pt e N x` returns the point with the
least possible index. -/
noncomputable def nearestPt (e : ℕ → α) (N : ℕ) : α →ₛ α :=
  (nearestPtInd e N).map e
#align measure_theory.simple_func.nearest_pt MeasureTheory.SimpleFunc.nearestPt

@[simp]
theorem nearestPtInd_zero (e : ℕ → α) : nearestPtInd e 0 = const α 0 :=
  rfl
#align measure_theory.simple_func.nearest_pt_ind_zero MeasureTheory.SimpleFunc.nearestPtInd_zero

@[simp]
theorem nearestPt_zero (e : ℕ → α) : nearestPt e 0 = const α (e 0) :=
  rfl
#align measure_theory.simple_func.nearest_pt_zero MeasureTheory.SimpleFunc.nearestPt_zero

theorem nearestPtInd_succ (e : ℕ → α) (N : ℕ) (x : α) :
    nearestPtInd e (N + 1) x =
      if ∀ k ≤ N, edist (e (N + 1)) x < edist (e k) x then N + 1 else nearestPtInd e N x :=
  by
  simp only [nearest_pt_ind, coe_piecewise, Set.piecewise]
  congr
  simp
#align measure_theory.simple_func.nearest_pt_ind_succ MeasureTheory.SimpleFunc.nearestPtInd_succ

theorem nearestPtInd_le (e : ℕ → α) (N : ℕ) (x : α) : nearestPtInd e N x ≤ N :=
  by
  induction' N with N ihN; · simp
  simp only [nearest_pt_ind_succ]
  split_ifs
  exacts[le_rfl, ihN.trans N.le_succ]
#align measure_theory.simple_func.nearest_pt_ind_le MeasureTheory.SimpleFunc.nearestPtInd_le

theorem edist_nearestPt_le (e : ℕ → α) (x : α) {k N : ℕ} (hk : k ≤ N) :
    edist (nearestPt e N x) x ≤ edist (e k) x :=
  by
  induction' N with N ihN generalizing k
  · simp [nonpos_iff_eq_zero.1 hk, le_refl]
  · simp only [nearest_pt, nearest_pt_ind_succ, map_apply]
    split_ifs
    · rcases hk.eq_or_lt with (rfl | hk)
      exacts[le_rfl, (h k (Nat.lt_succ_iff.1 hk)).le]
    · push_neg  at h
      rcases h with ⟨l, hlN, hxl⟩
      rcases hk.eq_or_lt with (rfl | hk)
      exacts[(ihN hlN).trans hxl, ihN (Nat.lt_succ_iff.1 hk)]
#align measure_theory.simple_func.edist_nearest_pt_le MeasureTheory.SimpleFunc.edist_nearestPt_le

theorem tendsto_nearestPt {e : ℕ → α} {x : α} (hx : x ∈ closure (range e)) :
    Tendsto (fun N => nearestPt e N x) atTop (𝓝 x) :=
  by
  refine' (at_top_basis.tendsto_iff nhds_basis_eball).2 fun ε hε => _
  rcases EMetric.mem_closure_iff.1 hx ε hε with ⟨_, ⟨N, rfl⟩, hN⟩
  rw [edist_comm] at hN
  exact ⟨N, trivial, fun n hn => (edist_nearest_pt_le e x hn).trans_lt hN⟩
#align measure_theory.simple_func.tendsto_nearest_pt MeasureTheory.SimpleFunc.tendsto_nearestPt

variable [MeasurableSpace β] {f : β → α}

/-- Approximate a measurable function by a sequence of simple functions `F n` such that
`F n x ∈ s`. -/
noncomputable def approxOn (f : β → α) (hf : Measurable f) (s : Set α) (y₀ : α) (h₀ : y₀ ∈ s)
    [SeparableSpace s] (n : ℕ) : β →ₛ α :=
  haveI : Nonempty s := ⟨⟨y₀, h₀⟩⟩
  comp (nearest_pt (fun k => Nat.casesOn k y₀ (coe ∘ dense_seq s) : ℕ → α) n) f hf
#align measure_theory.simple_func.approx_on MeasureTheory.SimpleFunc.approxOn

@[simp]
theorem approxOn_zero {f : β → α} (hf : Measurable f) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [SeparableSpace s] (x : β) : approxOn f hf s y₀ h₀ 0 x = y₀ :=
  rfl
#align measure_theory.simple_func.approx_on_zero MeasureTheory.SimpleFunc.approxOn_zero

theorem approxOn_mem {f : β → α} (hf : Measurable f) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [SeparableSpace s] (n : ℕ) (x : β) : approxOn f hf s y₀ h₀ n x ∈ s :=
  by
  haveI : Nonempty s := ⟨⟨y₀, h₀⟩⟩
  suffices ∀ n, (Nat.casesOn n y₀ (coe ∘ dense_seq s) : α) ∈ s by apply this
  rintro (_ | n)
  exacts[h₀, Subtype.mem _]
#align measure_theory.simple_func.approx_on_mem MeasureTheory.SimpleFunc.approxOn_mem

@[simp]
theorem approxOn_comp {γ : Type _} [MeasurableSpace γ] {f : β → α} (hf : Measurable f) {g : γ → β}
    (hg : Measurable g) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s) [SeparableSpace s] (n : ℕ) :
    approxOn (f ∘ g) (hf.comp hg) s y₀ h₀ n = (approxOn f hf s y₀ h₀ n).comp g hg :=
  rfl
#align measure_theory.simple_func.approx_on_comp MeasureTheory.SimpleFunc.approxOn_comp

theorem tendsto_approxOn {f : β → α} (hf : Measurable f) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [SeparableSpace s] {x : β} (hx : f x ∈ closure s) :
    Tendsto (fun n => approxOn f hf s y₀ h₀ n x) atTop (𝓝 <| f x) :=
  by
  haveI : Nonempty s := ⟨⟨y₀, h₀⟩⟩
  rw [← @Subtype.range_coe _ s, ← image_univ, ← (dense_range_dense_seq s).closure_eq] at hx
  simp only [approx_on, coe_comp]
  refine' tendsto_nearest_pt (closure_minimal _ isClosed_closure hx)
  simp only [Nat.range_casesOn, closure_union, range_comp coe]
  exact
    subset.trans (image_closure_subset_closure_image continuous_subtype_val)
      (subset_union_right _ _)
#align measure_theory.simple_func.tendsto_approx_on MeasureTheory.SimpleFunc.tendsto_approxOn

theorem edist_approxOn_mono {f : β → α} (hf : Measurable f) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [SeparableSpace s] (x : β) {m n : ℕ} (h : m ≤ n) :
    edist (approxOn f hf s y₀ h₀ n x) (f x) ≤ edist (approxOn f hf s y₀ h₀ m x) (f x) :=
  by
  dsimp only [approx_on, coe_comp, (· ∘ ·)]
  exact edist_nearest_pt_le _ _ ((nearest_pt_ind_le _ _ _).trans h)
#align measure_theory.simple_func.edist_approx_on_mono MeasureTheory.SimpleFunc.edist_approxOn_mono

theorem edist_approxOn_le {f : β → α} (hf : Measurable f) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [SeparableSpace s] (x : β) (n : ℕ) : edist (approxOn f hf s y₀ h₀ n x) (f x) ≤ edist y₀ (f x) :=
  edist_approxOn_mono hf h₀ x (zero_le n)
#align measure_theory.simple_func.edist_approx_on_le MeasureTheory.SimpleFunc.edist_approxOn_le

theorem edist_approxOn_y0_le {f : β → α} (hf : Measurable f) {s : Set α} {y₀ : α} (h₀ : y₀ ∈ s)
    [SeparableSpace s] (x : β) (n : ℕ) :
    edist y₀ (approxOn f hf s y₀ h₀ n x) ≤ edist y₀ (f x) + edist y₀ (f x) :=
  calc
    edist y₀ (approxOn f hf s y₀ h₀ n x) ≤
        edist y₀ (f x) + edist (approxOn f hf s y₀ h₀ n x) (f x) :=
      edist_triangle_right _ _ _
    _ ≤ edist y₀ (f x) + edist y₀ (f x) := add_le_add_left (edist_approxOn_le hf h₀ x n) _

#align measure_theory.simple_func.edist_approx_on_y0_le MeasureTheory.SimpleFunc.edist_approxOn_y0_le

end SimpleFunc

end MeasureTheory


import binary_tree

set_option trace.simplify.rewrite true
set_option trace.simp_lemmas true

open tree

variable {α : Type}
variable a: α
variable t: tree α

/-
# Complete Binary Trees

## Definition
-/
def complete : tree α → Prop
| nil := true
| (node a l r ) := height l = height r ∧ complete l ∧ complete r

/-
## Lemmas

Lemma 4.1 from __Functional Algorithms, Verified!__
-/
lemma complete_iff_height: complete t ↔ min_height t = height t :=
begin
  induction t with a l r l_ih r_ih,
  { simp [complete, min_height, height] },
  simp [complete, min_height, height, min_def, max_def, *],
  have: min_height r <= height r, from min_height_le_height r,
  have: min_height l <= height l, from min_height_le_height l,
  split_ifs,
  { apply iff.intro,
    { cc },
    intro h2,
    apply and.intro,
    repeat { linarith },
    apply and.intro,
    repeat { linarith } },
  { apply iff.intro,
    repeat { cc} },
  { apply iff.intro,
    repeat { cc } },
  apply iff.intro,
  { cc},
  intro h2,
  repeat { linarith },
end

/-
Lemma 4.2 from __Functional Algorithms, Verified!__
-/
lemma size1_if_complete : complete t → size1 t = 2 ^height t :=
begin
  induction t with a l r l_ih r_ih,
  repeat { simp [complete, height, size1] },
  intros,
  simp *,
  ring,
end

lemma size_if_complete: complete t → size t = (2 ^ height t) - 1 :=
begin
 intro,
 calc
  size t = size1 t - 1 : by simp [size1_size]
  ... = 2 ^ height t - 1: by simp [*, size1_if_complete]
end

/-
Lemma 4.3 from  __Functional Algorithms, Verified!__
-/
lemma size1_height_if_incomplete: ¬ complete t → size1 t < 2 ^ height t :=
begin
  induction t with a l r l_ih r_ih,
  repeat {simp [complete, size1, height, max_def]},
  intro h1,
  have h2: 2 <= 2, by trivial,
  by_cases h3: height l = height r,
  { simp * at h1,
    cases (not_or_of_imp h1),
    { simp [*, pow_ite] at * ,
      calc
        size1 l + size1 r < 2 ^ height l + size1 r : by simp *
        ... <= 2 ^ height l + 2 ^ height r : by simp [size1_height]
        ... = 2 ^ (height r + 1) :by {simp *, ring} },
    simp [*, pow_ite] at *,
    calc
      size1 l + size1 r < size1 l + 2 ^ height r : by simp *
      ... <= 2 ^ height l + 2 ^ height r : by simp [size1_height]
      ... = 2 ^ (height r + 1) :by {simp *, ring} },
  cases (ne.lt_or_lt h3),
  { have h3: ¬ height r <= height l, by linarith,
    have h4: 2 ^ height l < 2 ^ height r, from iff.elim_right (nat.pow_lt_iff_lt_right h2) h,
    simp [*, pow_ite],
    calc
      size1 l + size1 r <= size1 l + 2 ^ height r: by simp [size1_height]
      ... <= 2 ^ height l + 2 ^ height r : by simp [size1_height]
      ... < 2 ^ height r + 2 ^ height r : by simp *
      ... = 2 ^ (height r + 1) : by ring},
  have h3: height r <= height l, by linarith,
  have h4: 2 ^ height r < 2 ^ height l, from iff.elim_right (nat.pow_lt_iff_lt_right h2) h,
  simp [*, pow_ite],
  calc
      size1 l + size1 r <= size1 l + 2 ^ height r: by simp [size1_height]
      ... <= 2 ^ height l + 2 ^ height r : by simp [size1_height]
      ... < 2 ^ height l + 2 ^ height l : by simp *
      ... = 2 ^ (height l + 1) : by ring,
end

/-
Lemmma 4.4 from __Functional Algorithms, Verified!__
-/
lemma min_height_size1_if_incomplete: ¬ complete t → 2 ^ min_height t < size1 t :=
begin
  induction t with a l r l_ih r_ih,
  repeat { simp [complete, size1, min_height, min_def]},
  intro h1,
  have h2: 2 <= 2, by trivial,
  by_cases h3: min_height l = min_height r,
  { simp *,
    by_cases complete l ∧ complete r,
    { have h4: min_height l = height l, from iff.elim_left (complete_iff_height l) h.left,
      have h5: min_height r = height r, from iff.elim_left (complete_iff_height r) h.right,
      have h6: height l = height r, by cc,
      simp * at *, },
    rw [not_and_distrib] at h,
    cases h,
    { calc
        2 ^ (min_height r + 1) = 2 ^ min_height r + 2 ^ min_height r : by ring
        ... = 2 ^ min_height l + 2 ^ min_height r: by simp *
        ... <= 2 ^ min_height l + size1 r: by simp [min_height_size1]
        ... < size1 l + size1 r : by simp [l_ih h] },
    calc
      2 ^ (min_height r + 1) = 2 ^ min_height r + 2 ^ min_height r : by ring
      ... = 2 ^ min_height l + 2 ^ min_height r: by simp *
      ... <= size1 l + 2 ^ min_height r: by simp [min_height_size1]
      ... < size1 l + size1 r : by simp [r_ih h]},
  cases (ne.lt_or_lt h3),
  { have h4: min_height l <= min_height r, by linarith,
    simp [*, pow_ite],
    calc
      2 ^ (min_height l + 1) = 2 ^ min_height l + 2 ^ min_height l : by ring
      ... < 2 ^ min_height l + 2 ^ min_height r : by simp [iff.elim_right (nat.pow_lt_iff_lt_right h2) h]
      ... <= 2 ^ min_height l + size1 r: by simp [min_height_size1 l, min_height_size1 r]
      ... <= size1 l + size1 r: by simp [min_height_size1]},
  have h4: ¬ min_height l <= min_height r, by linarith,
  simp [*, pow_ite],
  calc
    2 ^ (min_height r + 1) = 2 ^ min_height r + 2 ^ min_height r : by ring
    ... < 2 ^ min_height l + 2 ^ min_height r : by simp [iff.elim_right (nat.pow_lt_iff_lt_right h2) h]
    ... <= 2 ^ min_height l + size1 r: by simp [min_height_size1 l, min_height_size1 r]
    ... <= size1 l + size1 r: by simp [min_height_size1]
end

lemma complete_if_size1_height: size1 t = 2 ^ height t → complete t :=
begin
  have h: ¬ size1 t < 2 ^ height t → complete t, from not.imp_symm (size1_height_if_incomplete t),
  intro h1,
  simp *,
end

lemma complete_if_size1_min_height: size1 t = 2 ^ min_height t → complete t :=
begin
  have h: ¬ 2 ^ min_height t < size1 t → complete t, from not.imp_symm (min_height_size1_if_incomplete t),
  intro h1,
  simp *,
end

/-
Corollary 4.5 from __Functional Algorithms, Verified!__
-/
lemma complete_iff_size1: complete t ↔ size1 t = 2 ^ height t :=
begin
  apply iff.intro,
  { exact size1_if_complete t },
  exact complete_if_size1_height t
end


import tactic
import data.nat.basic
import data.nat.prime

noncomputable theory
open_locale classical

open nat

lemma two_dvd_of_two_dvd_sq {k : ℕ}
  (hk : 2 ∣ k ^ 2)
: 2 ∣ k :=
begin
  sorry,
end

lemma division_lemma_n {m n : ℕ}
  (hmn : 2 * m ^ 2 = n ^ 2)
: 2 ∣ n :=
begin
  sorry,
end

lemma division_lemma_m {m n : ℕ}
  (hmn : 2 * m ^ 2 = n ^ 2)
: 2 ∣ m :=
begin
  sorry,
end

-- Assume that everything above this line is true.

--BEGIN--

/-
theorem nat.not_coprime_of_dvd_of_dvd  : 1 < d → d ∣ m → d ∣ n → ¬m.coprime n
-/

theorem sqrt2_irrational' :
  ¬ ∃ (m n : ℕ),
  2 * m^2 = n^2 ∧
  m.coprime n
:=
begin
  rintro ⟨m, n, hmn, h_cop⟩,
  -- these brackets let you combine ``rintro`` with (several iterations of) ``cases``
  -- try using ``rintro h`` and then ``rcases h with ⟨m, n, hmn, h_cop⟩,`` instead
  -- you get the brackets by typing ``\langle`` and ``\rangle``
  sorry,
end

--END--


/-
Copyright (c) 2020 Alexander Bentkamp, Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.complex.basic
import Mathlib.data.matrix.notation
import Mathlib.field_theory.tower
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Complex number as a vector space over `ℝ`

This file contains three instances:
* `ℂ` is an `ℝ` algebra;
* any complex vector space is a real vector space;
* any finite dimensional complex vector space is a finite dimesional real vector space;
* the space of `ℝ`-linear maps from a real vector space to a complex vector space is a complex
  vector space.

It also defines three linear maps:

* `complex.linear_map.re`;
* `complex.linear_map.im`;
* `complex.linear_map.of_real`.

They are bundled versions of the real part, the imaginary part, and the embedding of `ℝ` in `ℂ`,
as `ℝ`-linear maps.
-/

namespace complex

protected instance algebra_over_reals : algebra ℝ ℂ :=
  ring_hom.to_algebra of_real

@[simp] theorem coe_algebra_map : ⇑(algebra_map ℝ ℂ) = ⇑of_real :=
  rfl

@[simp] theorem re_smul (a : ℝ) (z : ℂ) : re (a • z) = a * re z := sorry

@[simp] theorem im_smul (a : ℝ) (z : ℂ) : im (a • z) = a * im z := sorry

theorem is_basis_one_I : is_basis ℝ (matrix.vec_cons 1 (matrix.vec_cons I matrix.vec_empty)) := sorry

protected instance finite_dimensional : finite_dimensional ℝ ℂ :=
  finite_dimensional.of_fintype_basis is_basis_one_I

@[simp] theorem findim_real_complex : finite_dimensional.findim ℝ ℂ = bit0 1 := sorry

@[simp] theorem dim_real_complex : vector_space.dim ℝ ℂ = bit0 1 := sorry

theorem dim_real_complex' : cardinal.lift (vector_space.dim ℝ ℂ) = bit0 1 := sorry

end complex

/- Register as an instance (with low priority) the fact that a complex vector space is also a real
vector space. -/

protected instance module.complex_to_real (E : Type u_1) [add_comm_group E] [module ℂ E] : module ℝ E :=
  restrict_scalars.semimodule ℝ ℂ E

protected instance module.real_complex_tower (E : Type u_1) [add_comm_group E] [module ℂ E] : is_scalar_tower ℝ ℂ E :=
  restrict_scalars.is_scalar_tower ℝ ℂ E

protected instance finite_dimensional.complex_to_real (E : Type u_1) [add_comm_group E] [module ℂ E] [finite_dimensional ℂ E] : finite_dimensional ℝ E :=
  finite_dimensional.trans ℝ ℂ E

theorem dim_real_of_complex (E : Type u_1) [add_comm_group E] [module ℂ E] : vector_space.dim ℝ E = bit0 1 * vector_space.dim ℂ E := sorry

theorem findim_real_of_complex (E : Type u_1) [add_comm_group E] [module ℂ E] : finite_dimensional.findim ℝ E = bit0 1 * finite_dimensional.findim ℂ E := sorry

namespace complex

/-- Linear map version of the real part function, from `ℂ` to `ℝ`. -/
def linear_map.re : linear_map ℝ ℂ ℝ :=
  linear_map.mk (fun (x : ℂ) => re x) add_re re_smul

@[simp] theorem linear_map.coe_re : ⇑linear_map.re = re :=
  rfl

/-- Linear map version of the imaginary part function, from `ℂ` to `ℝ`. -/
def linear_map.im : linear_map ℝ ℂ ℝ :=
  linear_map.mk (fun (x : ℂ) => im x) add_im im_smul

@[simp] theorem linear_map.coe_im : ⇑linear_map.im = im :=
  rfl

/-- Linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def linear_map.of_real : linear_map ℝ ℝ ℂ :=
  linear_map.mk coe of_real_add sorry

@[simp] theorem linear_map.coe_of_real : ⇑linear_map.of_real = coe :=
  rfl