/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

namespace Mathlib

/-!
# Bitwise operations on natural numbers

In the first half of this file, we provide theorems for reasoning about natural numbers from their
bitwise properties. In the second half of this file, we show properties of the bitwise operations
`lor`, `land` and `lxor`, which are defined in core.

## Main results
* `eq_of_test_bit_eq`: two natural numbers are equal if they have equal bits at every position.
* `exists_most_significant_bit`: if `n ≠ 0`, then there is some position `i` that contains the most
  significant `1`-bit of `n`.
* `lt_of_test_bit`: if `n` and `m` are numbers and `i` is a position such that the `i`-th bit of
  of `n` is zero, the `i`-th bit of `m` is one, and all more significant bits are equal, then
  `n < m`.

## Future work

There is another way to express bitwise properties of natural number: `digits 2`. The two ways
should be connected.

## Keywords

bitwise, and, or, xor
-/

namespace nat

@[simp] theorem bit_ff : bit false = bit0 := rfl

@[simp] theorem bit_tt : bit tt = bit1 := rfl

@[simp] theorem bit_eq_zero {n : ℕ} {b : Bool} : bit b n = 0 ↔ n = 0 ∧ b = false := sorry

theorem zero_of_test_bit_eq_ff {n : ℕ} (h : ∀ (i : ℕ), test_bit n i = false) : n = 0 := sorry

@[simp] theorem zero_test_bit (i : ℕ) : test_bit 0 i = false := sorry

/-- Bitwise extensionality: Two numbers agree if they agree at every bit position. -/
theorem eq_of_test_bit_eq {n : ℕ} {m : ℕ} (h : ∀ (i : ℕ), test_bit n i = test_bit m i) : n = m :=
  sorry

theorem exists_most_significant_bit {n : ℕ} (h : n ≠ 0) :
    ∃ (i : ℕ), test_bit n i = tt ∧ ∀ (j : ℕ), i < j → test_bit n j = false :=
  sorry

theorem lt_of_test_bit {n : ℕ} {m : ℕ} (i : ℕ) (hn : test_bit n i = false) (hm : test_bit m i = tt)
    (hnm : ∀ (j : ℕ), i < j → test_bit n j = test_bit m j) : n < m :=
  sorry

/-- If `f` is a commutative operation on bools such that `f ff ff = ff`, then `bitwise f` is also
    commutative. -/
theorem bitwise_comm {f : Bool → Bool → Bool} (hf : ∀ (b b' : Bool), f b b' = f b' b)
    (hf' : f false false = false) (n : ℕ) (m : ℕ) : bitwise f n m = bitwise f m n :=
  sorry

theorem lor_comm (n : ℕ) (m : ℕ) : lor n m = lor m n := bitwise_comm bool.bor_comm rfl n m

theorem land_comm (n : ℕ) (m : ℕ) : land n m = land m n := bitwise_comm bool.band_comm rfl n m

theorem lxor_comm (n : ℕ) (m : ℕ) : lxor n m = lxor m n := bitwise_comm bool.bxor_comm rfl n m

@[simp] theorem zero_lxor (n : ℕ) : lxor 0 n = n := rfl

@[simp] theorem lxor_zero (n : ℕ) : lxor n 0 = n := lxor_comm 0 n ▸ rfl

@[simp] theorem zero_land (n : ℕ) : land 0 n = 0 := rfl

@[simp] theorem land_zero (n : ℕ) : land n 0 = 0 := land_comm 0 n ▸ rfl

@[simp] theorem zero_lor (n : ℕ) : lor 0 n = n := rfl

@[simp] theorem lor_zero (n : ℕ) : lor n 0 = n := lor_comm 0 n ▸ rfl

/-- Proving associativity of bitwise operations in general essentially boils down to a huge case
    distinction, so it is shorter to use this tactic instead of proving it in the general case. -/
theorem lxor_assoc (n : ℕ) (m : ℕ) (k : ℕ) : lxor (lxor n m) k = lxor n (lxor m k) := sorry

theorem land_assoc (n : ℕ) (m : ℕ) (k : ℕ) : land (land n m) k = land n (land m k) := sorry

theorem lor_assoc (n : ℕ) (m : ℕ) (k : ℕ) : lor (lor n m) k = lor n (lor m k) := sorry

@[simp] theorem lxor_self (n : ℕ) : lxor n n = 0 := sorry

theorem lxor_right_inj {n : ℕ} {m : ℕ} {m' : ℕ} (h : lxor n m = lxor n m') : m = m' := sorry

theorem lxor_left_inj {n : ℕ} {n' : ℕ} {m : ℕ} (h : lxor n m = lxor n' m) : n = n' :=
  lxor_right_inj
    (eq.mp (Eq._oldrec (Eq.refl (lxor m n = lxor n' m)) (lxor_comm n' m))
      (eq.mp (Eq._oldrec (Eq.refl (lxor n m = lxor n' m)) (lxor_comm n m)) h))

theorem lxor_eq_zero {n : ℕ} {m : ℕ} : lxor n m = 0 ↔ n = m :=
  { mp :=
      eq.mpr (id (Eq._oldrec (Eq.refl (lxor n m = 0 → n = m)) (Eq.symm (lxor_self m))))
        lxor_left_inj,
    mpr := fun (ᾰ : n = m) => Eq._oldrec (lxor_self n) ᾰ }

theorem lxor_trichotomy {a : ℕ} {b : ℕ} {c : ℕ} (h : lxor a (lxor b c) ≠ 0) :
    lxor b c < a ∨ lxor a c < b ∨ lxor a b < c :=
  sorry

end Mathlib


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

/-!
# Finite intervals in a sigma type

This file provides the `locally_finite_order` instance for the disjoint sum of orders `Σ i, α i` and
calculates the cardinality of its finite intervals.

## TODO

Do the same for the lexicographical order
-/

open finset function

namespace sigma
variables {ι : Type*} {α : ι → Type*}

/-! ### Disjoint sum of orders -/

section disjoint
variables [decidable_eq ι] [Π i, preorder (α i)] [Π i, locally_finite_order (α i)]

instance : locally_finite_order (Σ i, α i) :=
{ finset_Icc := sigma_lift (λ _, Icc),
  finset_Ico := sigma_lift (λ _, Ico),
  finset_Ioc := sigma_lift (λ _, Ioc),
  finset_Ioo := sigma_lift (λ _, Ioo),
  finset_mem_Icc := λ ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩, begin
    simp_rw [mem_sigma_lift, le_def, mem_Icc, exists_and_distrib_left, ←exists_and_distrib_right,
      ←exists_prop],
    exact bex_congr (λ _ _, by split; rintro ⟨⟨⟩, ht⟩; exact ⟨rfl, ht⟩),
  end,
  finset_mem_Ico := λ ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩, begin
    simp_rw [mem_sigma_lift, le_def, lt_def, mem_Ico, exists_and_distrib_left,
      ←exists_and_distrib_right, ←exists_prop],
    exact bex_congr (λ _ _, by split; rintro ⟨⟨⟩, ht⟩; exact ⟨rfl, ht⟩),
  end,
  finset_mem_Ioc := λ ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩, begin
    simp_rw [mem_sigma_lift, le_def, lt_def, mem_Ioc, exists_and_distrib_left,
      ←exists_and_distrib_right, ←exists_prop],
    exact bex_congr (λ _ _, by split; rintro ⟨⟨⟩, ht⟩; exact ⟨rfl, ht⟩),
  end,
  finset_mem_Ioo := λ ⟨i, a⟩ ⟨j, b⟩ ⟨k, c⟩, begin
    simp_rw [mem_sigma_lift, lt_def, mem_Ioo, exists_and_distrib_left, ←exists_and_distrib_right,
      ←exists_prop],
    exact bex_congr (λ _ _, by split; rintro ⟨⟨⟩, ht⟩; exact ⟨rfl, ht⟩),
  end }

section
variables (a b : Σ i, α i)

lemma card_Icc : (Icc a b).card = if h : a.1 = b.1 then (Icc (h.rec a.2) b.2).card else 0 :=
card_sigma_lift _ _ _

lemma card_Ioc : (Ioc a b).card = if h : a.1 = b.1 then (Ioc (h.rec a.2) b.2).card else 0 :=
card_sigma_lift _ _ _

lemma card_Ioo : (Ioo a b).card = if h : a.1 = b.1 then (Ioo (h.rec a.2) b.2).card else 0 :=
card_sigma_lift _ _ _

end

variables (i : ι) (a b : α i)

@[simp] lemma Icc_mk_mk : Icc (⟨i, a⟩ : sigma α) ⟨i, b⟩ = (Icc a b).map (embedding.sigma_mk i) :=
dif_pos rfl

@[simp] lemma Ico_mk_mk : Ico (⟨i, a⟩ : sigma α) ⟨i, b⟩ = (Ico a b).map (embedding.sigma_mk i) :=
dif_pos rfl

@[simp] lemma Ioc_mk_mk : Ioc (⟨i, a⟩ : sigma α) ⟨i, b⟩ = (Ioc a b).map (embedding.sigma_mk i) :=
dif_pos rfl

@[simp] lemma Ioo_mk_mk : Ioo (⟨i, a⟩ : sigma α) ⟨i, b⟩ = (Ioo a b).map (embedding.sigma_mk i) :=
dif_pos rfl

end disjoint
end sigma


/-
Copyright (c) 2019 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudriashov, Yaël Dillies
-/
import algebra.order.invertible
import algebra.order.module
import linear_algebra.affine_space.midpoint
import linear_algebra.affine_space.affine_subspace
import linear_algebra.ray

/-!
# Convex sets and functions in vector spaces

In a 𝕜-vector space, we define the following objects and properties.
* `segment 𝕜 x y`: Closed segment joining `x` and `y`.
* `open_segment 𝕜 x y`: Open segment joining `x` and `y`.
* `convex 𝕜 s`: A set `s` is convex if for any two points `x y ∈ s` it includes `segment 𝕜 x y`.
* `std_simplex 𝕜 ι`: The standard simplex in `ι → 𝕜` (currently requires `fintype ι`). It is the
  intersection of the positive quadrant with the hyperplane `s.sum = 1`.

We also provide various equivalent versions of the definitions above, prove that some specific sets
are convex.

## Notations

We provide the following notation:
* `[x -[𝕜] y] = segment 𝕜 x y` in locale `convex`

## TODO

Generalize all this file to affine spaces.

Should we rename `segment` and `open_segment` to `convex.Icc` and `convex.Ioo`? Should we also
define `clopen_segment`/`convex.Ico`/`convex.Ioc`?
-/

variables {𝕜 E F β : Type*}

open linear_map set
open_locale big_operators classical pointwise

/-! ### Segment -/

section ordered_semiring
variables [ordered_semiring 𝕜] [add_comm_monoid E]

section has_smul
variables (𝕜) [has_smul 𝕜 E]

/-- Segments in a vector space. -/
def segment (x y : E) : set E :=
{z : E | ∃ (a b : 𝕜) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1), a • x + b • y = z}

/-- Open segment in a vector space. Note that `open_segment 𝕜 x x = {x}` instead of being `∅` when
the base semiring has some element between `0` and `1`. -/
def open_segment (x y : E) : set E :=
{z : E | ∃ (a b : 𝕜) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1), a • x + b • y = z}

localized "notation `[` x ` -[` 𝕜 `] ` y `]` := segment 𝕜 x y" in convex

lemma segment_eq_image₂ (x y : E) :
  [x -[𝕜] y] = (λ p : 𝕜 × 𝕜, p.1 • x + p.2 • y) '' {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 = 1} :=
by simp only [segment, image, prod.exists, mem_set_of_eq, exists_prop, and_assoc]

lemma open_segment_eq_image₂ (x y : E) :
  open_segment 𝕜 x y =
    (λ p : 𝕜 × 𝕜, p.1 • x + p.2 • y) '' {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 = 1} :=
by simp only [open_segment, image, prod.exists, mem_set_of_eq, exists_prop, and_assoc]

lemma segment_symm (x y : E) : [x -[𝕜] y] = [y -[𝕜] x] :=
set.ext $ λ z,
⟨λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩,
  λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩

lemma open_segment_symm (x y : E) :
  open_segment 𝕜 x y = open_segment 𝕜 y x :=
set.ext $ λ z,
⟨λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩,
  λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩

lemma open_segment_subset_segment (x y : E) :
  open_segment 𝕜 x y ⊆ [x -[𝕜] y] :=
λ z ⟨a, b, ha, hb, hab, hz⟩, ⟨a, b, ha.le, hb.le, hab, hz⟩

lemma segment_subset_iff {x y : E} {s : set E} :
  [x -[𝕜] y] ⊆ s ↔ ∀ a b : 𝕜, 0 ≤ a → 0 ≤ b → a + b = 1 → a • x + b • y ∈ s :=
⟨λ H a b ha hb hab, H ⟨a, b, ha, hb, hab, rfl⟩,
  λ H z ⟨a, b, ha, hb, hab, hz⟩, hz ▸ H a b ha hb hab⟩

lemma open_segment_subset_iff {x y : E} {s : set E} :
  open_segment 𝕜 x y ⊆ s ↔ ∀ a b : 𝕜, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s :=
⟨λ H a b ha hb hab, H ⟨a, b, ha, hb, hab, rfl⟩,
  λ H z ⟨a, b, ha, hb, hab, hz⟩, hz ▸ H a b ha hb hab⟩

end has_smul

open_locale convex

section mul_action_with_zero
variables (𝕜) [mul_action_with_zero 𝕜 E]

lemma left_mem_segment (x y : E) : x ∈ [x -[𝕜] y] :=
⟨1, 0, zero_le_one, le_refl 0, add_zero 1, by rw [zero_smul, one_smul, add_zero]⟩

lemma right_mem_segment (x y : E) : y ∈ [x -[𝕜] y] :=
segment_symm 𝕜 y x ▸ left_mem_segment 𝕜 y x

end mul_action_with_zero

section module
variables (𝕜) [module 𝕜 E] {x y z : E} {s : set E}

@[simp] lemma segment_same (x : E) : [x -[𝕜] x] = {x} :=
set.ext $ λ z, ⟨λ ⟨a, b, ha, hb, hab, hz⟩,
  by simpa only [(add_smul _ _ _).symm, mem_singleton_iff, hab, one_smul, eq_comm] using hz,
  λ h, mem_singleton_iff.1 h ▸ left_mem_segment 𝕜 z z⟩

lemma insert_endpoints_open_segment (x y : E) :
  insert x (insert y (open_segment 𝕜 x y)) = [x -[𝕜] y] :=
begin
  simp only [subset_antisymm_iff, insert_subset, left_mem_segment, right_mem_segment,
    open_segment_subset_segment, true_and],
  rintro z ⟨a, b, ha, hb, hab, rfl⟩,
  refine hb.eq_or_gt.imp _ (λ hb', ha.eq_or_gt.imp _ _),
  { rintro rfl,
    rw add_zero at hab,
    rw [hab, one_smul, zero_smul, add_zero] },
  { rintro rfl,
    rw zero_add at hab,
    rw [hab, one_smul, zero_smul, zero_add] },
  { exact λ ha', ⟨a, b, ha', hb', hab, rfl⟩ }
end

variables {𝕜}

lemma mem_open_segment_of_ne_left_right (hx : x ≠ z) (hy : y ≠ z) (hz : z ∈ [x -[𝕜] y]) :
  z ∈ open_segment 𝕜 x y :=
begin
  rw [← insert_endpoints_open_segment] at hz,
  exact ((hz.resolve_left hx.symm).resolve_left hy.symm)
end

lemma open_segment_subset_iff_segment_subset (hx : x ∈ s) (hy : y ∈ s) :
  open_segment 𝕜 x y ⊆ s ↔ [x -[𝕜] y] ⊆ s :=
by simp only [← insert_endpoints_open_segment, insert_subset, *, true_and]

end module
end ordered_semiring

open_locale convex

section ordered_ring
variables [ordered_ring 𝕜]

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

section densely_ordered
variables [nontrivial 𝕜] [densely_ordered 𝕜]

@[simp] lemma open_segment_same (x : E) :
  open_segment 𝕜 x x = {x} :=
set.ext $ λ z, ⟨λ ⟨a, b, ha, hb, hab, hz⟩,
  by simpa only [← add_smul, mem_singleton_iff, hab, one_smul, eq_comm] using hz,
  λ (h : z = x), begin
    obtain ⟨a, ha₀, ha₁⟩ := densely_ordered.dense (0 : 𝕜) 1 zero_lt_one,
    refine ⟨a, 1 - a, ha₀, sub_pos_of_lt ha₁, add_sub_cancel'_right _ _, _⟩,
    rw [←add_smul, add_sub_cancel'_right, one_smul, h],
  end⟩

end densely_ordered

lemma segment_eq_image (x y : E) : [x -[𝕜] y] = (λ θ : 𝕜, (1 - θ) • x + θ • y) '' Icc (0 : 𝕜) 1 :=
set.ext $ λ z,
  ⟨λ ⟨a, b, ha, hb, hab, hz⟩,
    ⟨b, ⟨hb, hab ▸ le_add_of_nonneg_left ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩,
    λ ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩, ⟨1-θ, θ, sub_nonneg.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩

lemma open_segment_eq_image (x y : E) :
  open_segment 𝕜 x y = (λ (θ : 𝕜), (1 - θ) • x + θ • y) '' Ioo (0 : 𝕜) 1 :=
set.ext $ λ z,
  ⟨λ ⟨a, b, ha, hb, hab, hz⟩,
    ⟨b, ⟨hb, hab ▸ lt_add_of_pos_left _ ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩,
    λ ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩, ⟨1 - θ, θ, sub_pos.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩

lemma segment_eq_image' (x y : E) :
  [x -[𝕜] y] = (λ (θ : 𝕜), x + θ • (y - x)) '' Icc (0 : 𝕜) 1 :=
by { convert segment_eq_image 𝕜 x y, ext θ, simp only [smul_sub, sub_smul, one_smul], abel }

lemma open_segment_eq_image' (x y : E) :
  open_segment 𝕜 x y = (λ (θ : 𝕜), x + θ • (y - x)) '' Ioo (0 : 𝕜) 1 :=
by { convert open_segment_eq_image 𝕜 x y, ext θ, simp only [smul_sub, sub_smul, one_smul], abel }

lemma segment_eq_image_line_map (x y : E) :
  [x -[𝕜] y] = affine_map.line_map x y '' Icc (0 : 𝕜) 1 :=
by { convert segment_eq_image 𝕜 x y, ext, exact affine_map.line_map_apply_module _ _ _ }

lemma open_segment_eq_image_line_map (x y : E) :
  open_segment 𝕜 x y = affine_map.line_map x y '' Ioo (0 : 𝕜) 1 :=
by { convert open_segment_eq_image 𝕜 x y, ext, exact affine_map.line_map_apply_module _ _ _ }

lemma segment_image (f : E →ₗ[𝕜] F) (a b : E) : f '' [a -[𝕜] b] = [f a -[𝕜] f b] :=
set.ext (λ x, by simp_rw [segment_eq_image, mem_image, exists_exists_and_eq_and, map_add, map_smul])

@[simp] lemma open_segment_image (f : E →ₗ[𝕜] F) (a b : E) :
  f '' open_segment 𝕜 a b = open_segment 𝕜 (f a) (f b) :=
set.ext (λ x, by simp_rw [open_segment_eq_image, mem_image, exists_exists_and_eq_and, map_add,
  map_smul])

lemma mem_segment_translate (a : E) {x b c} : a + x ∈ [a + b -[𝕜] a + c] ↔ x ∈ [b -[𝕜] c] :=
begin
  rw [segment_eq_image', segment_eq_image'],
  refine exists_congr (λ θ, and_congr iff.rfl _),
  simp only [add_sub_add_left_eq_sub, add_assoc, add_right_inj],
end

@[simp] lemma mem_open_segment_translate (a : E) {x b c : E} :
  a + x ∈ open_segment 𝕜 (a + b) (a + c) ↔ x ∈ open_segment 𝕜 b c :=
begin
  rw [open_segment_eq_image', open_segment_eq_image'],
  refine exists_congr (λ θ, and_congr iff.rfl _),
  simp only [add_sub_add_left_eq_sub, add_assoc, add_right_inj],
end

lemma segment_translate_preimage (a b c : E) : (λ x, a + x) ⁻¹' [a + b -[𝕜] a + c] = [b -[𝕜] c] :=
set.ext $ λ x, mem_segment_translate 𝕜 a

lemma open_segment_translate_preimage (a b c : E) :
  (λ x, a + x) ⁻¹' open_segment 𝕜 (a + b) (a + c) = open_segment 𝕜 b c :=
set.ext $ λ x, mem_open_segment_translate 𝕜 a

lemma segment_translate_image (a b c : E) : (λ x, a + x) '' [b -[𝕜] c] = [a + b -[𝕜] a + c] :=
segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ $ add_left_surjective a

lemma open_segment_translate_image (a b c : E) :
  (λ x, a + x) '' open_segment 𝕜 b c = open_segment 𝕜 (a + b) (a + c) :=
open_segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ $ add_left_surjective a

end add_comm_group
end ordered_ring

lemma same_ray_of_mem_segment [ordered_comm_ring 𝕜] [add_comm_group E] [module 𝕜 E]
  {x y z : E} (h : x ∈ [y -[𝕜] z]) : same_ray 𝕜 (x - y) (z - x) :=
begin
  rw segment_eq_image' at h,
  rcases h with ⟨θ, ⟨hθ₀, hθ₁⟩, rfl⟩,
  simpa only [add_sub_cancel', ← sub_sub, sub_smul, one_smul]
    using (same_ray_nonneg_smul_left (z - y) hθ₀).nonneg_smul_right (sub_nonneg.2 hθ₁)
end

section linear_ordered_ring
variables [linear_ordered_ring 𝕜]

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

lemma midpoint_mem_segment [invertible (2 : 𝕜)] (x y : E) :
  midpoint 𝕜 x y ∈ [x -[𝕜] y] :=
begin
  rw segment_eq_image_line_map,
  exact ⟨⅟2, ⟨inv_of_nonneg.mpr zero_le_two, inv_of_le_one one_le_two⟩, rfl⟩,
end

lemma mem_segment_sub_add [invertible (2 : 𝕜)] (x y : E) :
  x ∈ [x-y -[𝕜] x+y] :=
begin
  convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _,
  rw midpoint_sub_add
end

lemma mem_segment_add_sub [invertible (2 : 𝕜)] (x y : E) :
  x ∈ [x+y -[𝕜] x-y] :=
begin
  convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _,
  rw midpoint_add_sub
end

@[simp] lemma left_mem_open_segment_iff [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] {x y : E} :
  x ∈ open_segment 𝕜 x y ↔ x = y :=
begin
  split,
  { rintro ⟨a, b, ha, hb, hab, hx⟩,
    refine smul_right_injective _ hb.ne' ((add_right_inj (a • x)).1 _),
    rw [hx, ←add_smul, hab, one_smul] },
  { rintro rfl,
    rw open_segment_same,
    exact mem_singleton _ }
end

@[simp] lemma right_mem_open_segment_iff [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] {x y : E} :
  y ∈ open_segment 𝕜 x y ↔ x = y :=
by rw [open_segment_symm, left_mem_open_segment_iff, eq_comm]

end add_comm_group
end linear_ordered_ring

section linear_ordered_field
variables [linear_ordered_field 𝕜]

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

lemma mem_segment_iff_same_ray : x ∈ [y -[𝕜] z] ↔ same_ray 𝕜 (x - y) (z - x) :=
begin
  refine ⟨same_ray_of_mem_segment, λ h, _⟩,
  rcases h.exists_eq_smul_add with ⟨a, b, ha, hb, hab, hxy, hzx⟩,
  rw [add_comm, sub_add_sub_cancel] at hxy hzx,
  rw [← mem_segment_translate _ (-x), neg_add_self],
  refine ⟨b, a, hb, ha, add_comm a b ▸ hab, _⟩,
  rw [← sub_eq_neg_add, ← neg_sub, hxy, ← sub_eq_neg_add, hzx, smul_neg, smul_comm, neg_add_self]
end

lemma mem_segment_iff_div : x ∈ [y -[𝕜] z] ↔
  ∃ a b : 𝕜, 0 ≤ a ∧ 0 ≤ b ∧ 0 < a + b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x :=
begin
  split,
  { rintro ⟨a, b, ha, hb, hab, rfl⟩,
    use [a, b, ha, hb],
    simp * },
  { rintro ⟨a, b, ha, hb, hab, rfl⟩,
    refine ⟨a / (a + b), b / (a + b), div_nonneg ha hab.le, div_nonneg hb hab.le, _, rfl⟩,
    rw [← add_div, div_self hab.ne'] }
end

lemma mem_open_segment_iff_div : x ∈ open_segment 𝕜 y z ↔
  ∃ a b : 𝕜, 0 < a ∧ 0 < b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x :=
begin
  split,
  { rintro ⟨a, b, ha, hb, hab, rfl⟩,
    use [a, b, ha, hb],
    rw [hab, div_one, div_one] },
  { rintro ⟨a, b, ha, hb, rfl⟩,
    have hab : 0 < a + b, from add_pos ha hb,
    refine ⟨a / (a + b), b / (a + b), div_pos ha hab, div_pos hb hab, _, rfl⟩,
    rw [← add_div, div_self hab.ne'] }
end

end add_comm_group
end linear_ordered_field

/-!
#### Segments in an ordered space
Relates `segment`, `open_segment` and `set.Icc`, `set.Ico`, `set.Ioc`, `set.Ioo`
-/
section ordered_semiring
variables [ordered_semiring 𝕜]

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E]

lemma segment_subset_Icc {x y : E} (h : x ≤ y) : [x -[𝕜] y] ⊆ Icc x y :=
begin
  rintro z ⟨a, b, ha, hb, hab, rfl⟩,
  split,
  calc
    x   = a • x + b • x :(convex.combo_self hab _).symm
    ... ≤ a • x + b • y : add_le_add_left (smul_le_smul_of_nonneg h hb) _,
  calc
    a • x + b • y
        ≤ a • y + b • y : add_le_add_right (smul_le_smul_of_nonneg h ha) _
    ... = y : convex.combo_self hab _,
end

end ordered_add_comm_monoid

section ordered_cancel_add_comm_monoid
variables [ordered_cancel_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E]

lemma open_segment_subset_Ioo {x y : E} (h : x < y) : open_segment 𝕜 x y ⊆ Ioo x y :=
begin
  rintro z ⟨a, b, ha, hb, hab, rfl⟩,
  split,
  calc
    x   = a • x + b • x : (convex.combo_self hab _).symm
    ... < a • x + b • y : add_lt_add_left (smul_lt_smul_of_pos h hb) _,
  calc
    a • x + b • y
        < a • y + b • y : add_lt_add_right (smul_lt_smul_of_pos h ha) _
    ... = y : convex.combo_self hab _,
end

end ordered_cancel_add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] {𝕜}

lemma segment_subset_interval (x y : E) : [x -[𝕜] y] ⊆ interval x y :=
begin
  cases le_total x y,
  { rw interval_of_le h,
    exact segment_subset_Icc h },
  { rw [interval_of_ge h, segment_symm],
    exact segment_subset_Icc h }
end

lemma convex.min_le_combo (x y : E) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
  min x y ≤ a • x + b • y :=
(segment_subset_interval x y ⟨_, _, ha, hb, hab, rfl⟩).1

lemma convex.combo_le_max (x y : E) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • x + b • y ≤ max x y :=
(segment_subset_interval x y ⟨_, _, ha, hb, hab, rfl⟩).2

end linear_ordered_add_comm_monoid
end ordered_semiring

section linear_ordered_field
variables [linear_ordered_field 𝕜]

lemma Icc_subset_segment {x y : 𝕜} : Icc x y ⊆ [x -[𝕜] y] :=
begin
  rintro z ⟨hxz, hyz⟩,
  obtain rfl | h := (hxz.trans hyz).eq_or_lt,
  { rw segment_same,
    exact hyz.antisymm hxz },
  rw ←sub_nonneg at hxz hyz,
  rw ←sub_pos at h,
  refine ⟨(y - z) / (y - x), (z - x) / (y - x), div_nonneg hyz h.le, div_nonneg hxz h.le, _, _⟩,
  { rw [←add_div, sub_add_sub_cancel, div_self h.ne'] },
  { rw [smul_eq_mul, smul_eq_mul, ←mul_div_right_comm, ←mul_div_right_comm, ←add_div,
      div_eq_iff h.ne', add_comm, sub_mul, sub_mul, mul_comm x, sub_add_sub_cancel, mul_sub] }
end

@[simp] lemma segment_eq_Icc {x y : 𝕜} (h : x ≤ y) : [x -[𝕜] y] = Icc x y :=
(segment_subset_Icc h).antisymm Icc_subset_segment

lemma Ioo_subset_open_segment {x y : 𝕜} : Ioo x y ⊆ open_segment 𝕜 x y :=
λ z hz, mem_open_segment_of_ne_left_right hz.1.ne hz.2.ne'
    (Icc_subset_segment $ Ioo_subset_Icc_self hz)

@[simp] lemma open_segment_eq_Ioo {x y : 𝕜} (h : x < y) : open_segment 𝕜 x y = Ioo x y :=
(open_segment_subset_Ioo h).antisymm Ioo_subset_open_segment

lemma segment_eq_Icc' (x y : 𝕜) : [x -[𝕜] y] = Icc (min x y) (max x y) :=
begin
  cases le_total x y,
  { rw [segment_eq_Icc h, max_eq_right h, min_eq_left h] },
  { rw [segment_symm, segment_eq_Icc h, max_eq_left h, min_eq_right h] }
end

lemma open_segment_eq_Ioo' {x y : 𝕜} (hxy : x ≠ y) :
  open_segment 𝕜 x y = Ioo (min x y) (max x y) :=
begin
  cases hxy.lt_or_lt,
  { rw [open_segment_eq_Ioo h, max_eq_right h.le, min_eq_left h.le] },
  { rw [open_segment_symm, open_segment_eq_Ioo h, max_eq_left h.le, min_eq_right h.le] }
end

lemma segment_eq_interval (x y : 𝕜) : [x -[𝕜] y] = interval x y :=
segment_eq_Icc' _ _

/-- A point is in an `Icc` iff it can be expressed as a convex combination of the endpoints. -/
lemma convex.mem_Icc {x y : 𝕜} (h : x ≤ y) {z : 𝕜} :
  z ∈ Icc x y ↔ ∃ (a b : 𝕜), 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z :=
begin
  rw ←segment_eq_Icc h,
  simp_rw [←exists_prop],
  refl,
end

/-- A point is in an `Ioo` iff it can be expressed as a strict convex combination of the endpoints.
-/
lemma convex.mem_Ioo {x y : 𝕜} (h : x < y) {z : 𝕜} :
  z ∈ Ioo x y ↔ ∃ (a b : 𝕜), 0 < a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z :=
begin
  rw ←open_segment_eq_Ioo h,
  simp_rw [←exists_prop],
  refl,
end

/-- A point is in an `Ioc` iff it can be expressed as a semistrict convex combination of the
endpoints. -/
lemma convex.mem_Ioc {x y : 𝕜} (h : x < y) {z : 𝕜} :
  z ∈ Ioc x y ↔ ∃ (a b : 𝕜), 0 ≤ a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z :=
begin
  split,
  { rintro hz,
    obtain ⟨a, b, ha, hb, hab, rfl⟩ := (convex.mem_Icc h.le).1 (Ioc_subset_Icc_self hz),
    obtain rfl | hb' := hb.eq_or_lt,
    { rw add_zero at hab,
      rw [hab, one_mul, zero_mul, add_zero] at hz,
      exact (hz.1.ne rfl).elim },
    { exact ⟨a, b, ha, hb', hab, rfl⟩ } },
  { rintro ⟨a, b, ha, hb, hab, rfl⟩,
    obtain rfl | ha' := ha.eq_or_lt,
    { rw zero_add at hab,
      rwa [hab, one_mul, zero_mul, zero_add, right_mem_Ioc] },
    { exact Ioo_subset_Ioc_self ((convex.mem_Ioo h).2 ⟨a, b, ha', hb, hab, rfl⟩) } }
end

/-- A point is in an `Ico` iff it can be expressed as a semistrict convex combination of the
endpoints. -/
lemma convex.mem_Ico {x y : 𝕜} (h : x < y) {z : 𝕜} :
  z ∈ Ico x y ↔ ∃ (a b : 𝕜), 0 < a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z :=
begin
  split,
  { rintro hz,
    obtain ⟨a, b, ha, hb, hab, rfl⟩ := (convex.mem_Icc h.le).1 (Ico_subset_Icc_self hz),
    obtain rfl | ha' := ha.eq_or_lt,
    { rw zero_add at hab,
      rw [hab, one_mul, zero_mul, zero_add] at hz,
      exact (hz.2.ne rfl).elim },
    { exact ⟨a, b, ha', hb, hab, rfl⟩ } },
  { rintro ⟨a, b, ha, hb, hab, rfl⟩,
    obtain rfl | hb' := hb.eq_or_lt,
    { rw add_zero at hab,
      rwa [hab, one_mul, zero_mul, add_zero, left_mem_Ico] },
    { exact Ioo_subset_Ico_self ((convex.mem_Ioo h).2 ⟨a, b, ha, hb', hab, rfl⟩) } }
end

end linear_ordered_field

/-! ### Convexity of sets -/

section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

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

/-- Convexity of sets. -/
def convex : Prop :=
∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
  a • x + b • y ∈ s

variables {𝕜 s}

lemma convex_iff_segment_subset :
  convex 𝕜 s ↔ ∀ ⦃x y⦄, x ∈ s → y ∈ s → [x -[𝕜] y] ⊆ s :=
forall₄_congr $ λ x y hx hy, (segment_subset_iff _).symm

lemma convex.segment_subset (h : convex 𝕜 s) {x y : E} (hx : x ∈ s) (hy : y ∈ s) :
  [x -[𝕜] y] ⊆ s :=
convex_iff_segment_subset.1 h hx hy

lemma convex.open_segment_subset (h : convex 𝕜 s) {x y : E} (hx : x ∈ s) (hy : y ∈ s) :
  open_segment 𝕜 x y ⊆ s :=
(open_segment_subset_segment 𝕜 x y).trans (h.segment_subset hx hy)

/-- Alternative definition of set convexity, in terms of pointwise set operations. -/
lemma convex_iff_pointwise_add_subset :
  convex 𝕜 s ↔ ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → a • s + b • s ⊆ s :=
iff.intro
  begin
    rintro hA a b ha hb hab w ⟨au, bv, ⟨u, hu, rfl⟩, ⟨v, hv, rfl⟩, rfl⟩,
    exact hA hu hv ha hb hab
  end
  (λ h x y hx hy a b ha hb hab,
    (h ha hb hab) (set.add_mem_add ⟨_, hx, rfl⟩ ⟨_, hy, rfl⟩))

alias convex_iff_pointwise_add_subset ↔ convex.set_combo_subset _

lemma convex_empty : convex 𝕜 (∅ : set E) :=
λ x y, false.elim

lemma convex_univ : convex 𝕜 (set.univ : set E) := λ _ _ _ _ _ _ _ _ _, trivial

lemma convex.inter {t : set E} (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s ∩ t) :=
λ x y (hx : x ∈ s ∩ t) (hy : y ∈ s ∩ t) a b (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1),
  ⟨hs hx.left hy.left ha hb hab, ht hx.right hy.right ha hb hab⟩

lemma convex_sInter {S : set (set E)} (h : ∀ s ∈ S, convex 𝕜 s) : convex 𝕜 (⋂₀ S) :=
assume x y hx hy a b ha hb hab s hs,
h s hs (hx s hs) (hy s hs) ha hb hab

lemma convex_Inter {ι : Sort*} {s : ι → set E} (h : ∀ i, convex 𝕜 (s i)) : convex 𝕜 (⋂ i, s i) :=
(sInter_range s) ▸ convex_sInter $ forall_range_iff.2 h

lemma convex_Inter₂ {ι : Sort*} {κ : ι → Sort*} {s : Π i, κ i → set E}
  (h : ∀ i j, convex 𝕜 (s i j)) :
  convex 𝕜 (⋂ i j, s i j) :=
convex_Inter $ λ i, convex_Inter $ h i

lemma convex.prod {s : set E} {t : set F} (hs : convex 𝕜 s) (ht : convex 𝕜 t) :
  convex 𝕜 (s ×ˢ t) :=
begin
  intros x y hx hy a b ha hb hab,
  apply mem_prod.2,
  exact ⟨hs (mem_prod.1 hx).1 (mem_prod.1 hy).1 ha hb hab,
        ht (mem_prod.1 hx).2 (mem_prod.1 hy).2 ha hb hab⟩
end

lemma convex_pi {ι : Type*} {E : ι → Type*} [Π i, add_comm_monoid (E i)]
  [Π i, has_smul 𝕜 (E i)] {s : set ι} {t : Π i, set (E i)} (ht : ∀ i, convex 𝕜 (t i)) :
  convex 𝕜 (s.pi t) :=
λ x y hx hy a b ha hb hab i hi, ht i (hx i hi) (hy i hi) ha hb hab

lemma directed.convex_Union {ι : Sort*} {s : ι → set E} (hdir : directed (⊆) s)
  (hc : ∀ ⦃i : ι⦄, convex 𝕜 (s i)) :
  convex 𝕜 (⋃ i, s i) :=
begin
  rintro x y hx hy 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 ⟨k, hc (hik hx) (hjk hy) ha hb hab⟩,
end

lemma directed_on.convex_sUnion {c : set (set E)} (hdir : directed_on (⊆) c)
  (hc : ∀ ⦃A : set E⦄, A ∈ c → convex 𝕜 A) :
  convex 𝕜 (⋃₀c) :=
begin
  rw sUnion_eq_Union,
  exact (directed_on_iff_directed.1 hdir).convex_Union (λ A, hc A.2),
end

end has_smul

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

lemma convex_iff_open_segment_subset :
  convex 𝕜 s ↔ ∀ ⦃x y⦄, x ∈ s → y ∈ s → open_segment 𝕜 x y ⊆ s :=
convex_iff_segment_subset.trans $ forall₄_congr $ λ x y hx hy,
  (open_segment_subset_iff_segment_subset hx hy).symm

lemma convex_iff_forall_pos :
  convex 𝕜 s ↔ ∀ ⦃x y⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1
  → a • x + b • y ∈ s :=
convex_iff_open_segment_subset.trans $ forall₄_congr $ λ x y hx hy,
  open_segment_subset_iff 𝕜

lemma convex_iff_pairwise_pos :
  convex 𝕜 s ↔ s.pairwise (λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s) :=
begin
  refine convex_iff_forall_pos.trans ⟨λ h x hx y hy _, h hx hy, _⟩,
  intros h x y hx hy a b ha hb hab,
  obtain rfl | hxy := eq_or_ne x y,
  { rwa convex.combo_self hab },
  { exact h hx hy hxy ha hb hab },
end

protected lemma set.subsingleton.convex {s : set E} (h : s.subsingleton) : convex 𝕜 s :=
convex_iff_pairwise_pos.mpr (h.pairwise _)

lemma convex_singleton (c : E) : convex 𝕜 ({c} : set E) :=
subsingleton_singleton.convex

lemma convex_segment (x y : E) : convex 𝕜 [x -[𝕜] y] :=
begin
  rintro p q ⟨ap, bp, hap, hbp, habp, rfl⟩ ⟨aq, bq, haq, hbq, habq, rfl⟩ a b ha hb hab,
  refine ⟨a * ap + b * aq, a * bp + b * bq,
    add_nonneg (mul_nonneg ha hap) (mul_nonneg hb haq),
    add_nonneg (mul_nonneg ha hbp) (mul_nonneg hb hbq), _, _⟩,
  { rw [add_add_add_comm, ←mul_add, ←mul_add, habp, habq, mul_one, mul_one, hab] },
  { simp_rw [add_smul, mul_smul, smul_add],
    exact add_add_add_comm _ _ _ _ }
end

lemma convex_open_segment (a b : E) : convex 𝕜 (open_segment 𝕜 a b) :=
begin
  rw convex_iff_open_segment_subset,
  rintro p q ⟨ap, bp, hap, hbp, habp, rfl⟩ ⟨aq, bq, haq, hbq, habq, rfl⟩ z ⟨a, b, ha, hb, hab, rfl⟩,
  refine ⟨a * ap + b * aq, a * bp + b * bq,
    add_pos (mul_pos ha hap) (mul_pos hb haq),
    add_pos (mul_pos ha hbp) (mul_pos hb hbq), _, _⟩,
  { rw [add_add_add_comm, ←mul_add, ←mul_add, habp, habq, mul_one, mul_one, hab] },
  { simp_rw [add_smul, mul_smul, smul_add],
    exact add_add_add_comm _ _ _ _ }
end

lemma convex.linear_image (hs : convex 𝕜 s) (f : E →ₗ[𝕜] F) : convex 𝕜 (f '' s) :=
begin
  intros x y hx hy a b ha hb hab,
  obtain ⟨x', hx', rfl⟩ := mem_image_iff_bex.1 hx,
  obtain ⟨y', hy', rfl⟩ := mem_image_iff_bex.1 hy,
  exact ⟨a • x' + b • y', hs hx' hy' ha hb hab, by rw [f.map_add, f.map_smul, f.map_smul]⟩,
end

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

lemma convex.linear_preimage {s : set F} (hs : convex 𝕜 s) (f : E →ₗ[𝕜] F) :
  convex 𝕜 (f ⁻¹' s) :=
begin
  intros x y hx hy a b ha hb hab,
  rw [mem_preimage, f.map_add, f.map_smul, f.map_smul],
  exact hs hx hy ha hb hab,
end

lemma convex.is_linear_preimage {s : set F} (hs : convex 𝕜 s) {f : E → F} (hf : is_linear_map 𝕜 f) :
  convex 𝕜 (f ⁻¹' s) :=
hs.linear_preimage $ hf.mk' f

lemma convex.add {t : set E} (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s + t) :=
by { rw ← add_image_prod, exact (hs.prod ht).is_linear_image is_linear_map.is_linear_map_add }

lemma convex.vadd (hs : convex 𝕜 s) (z : E) : convex 𝕜 (z +ᵥ s) :=
by { simp_rw [←image_vadd, vadd_eq_add, ←singleton_add], exact (convex_singleton _).add hs }

lemma convex.translate (hs : convex 𝕜 s) (z : E) : convex 𝕜 ((λ x, z + x) '' s) := hs.vadd _

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

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

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid β] [module 𝕜 β] [ordered_smul 𝕜 β]

lemma convex_Iic (r : β) : convex 𝕜 (Iic r) :=
λ x y hx hy a b ha hb hab,
calc
  a • x + b • y
      ≤ a • r + b • r
      : add_le_add (smul_le_smul_of_nonneg hx ha) (smul_le_smul_of_nonneg hy hb)
  ... = r : convex.combo_self hab _

lemma convex_Ici (r : β) : convex 𝕜 (Ici r) := @convex_Iic 𝕜 βᵒᵈ _ _ _ _ r

lemma convex_Icc (r s : β) : convex 𝕜 (Icc r s) :=
Ici_inter_Iic.subst ((convex_Ici r).inter $ convex_Iic s)

lemma convex_halfspace_le {f : E → β} (h : is_linear_map 𝕜 f) (r : β) :
  convex 𝕜 {w | f w ≤ r} :=
(convex_Iic r).is_linear_preimage h

lemma convex_halfspace_ge {f : E → β} (h : is_linear_map 𝕜 f) (r : β) :
  convex 𝕜 {w | r ≤ f w} :=
(convex_Ici r).is_linear_preimage h

lemma convex_hyperplane {f : E → β} (h : is_linear_map 𝕜 f) (r : β) :
  convex 𝕜 {w | f w = r} :=
begin
  simp_rw le_antisymm_iff,
  exact (convex_halfspace_le h r).inter (convex_halfspace_ge h r),
end

end ordered_add_comm_monoid

section ordered_cancel_add_comm_monoid
variables [ordered_cancel_add_comm_monoid β] [module 𝕜 β] [ordered_smul 𝕜 β]

lemma convex_Iio (r : β) : convex 𝕜 (Iio r) :=
begin
  intros x y hx hy a b ha hb hab,
  obtain rfl | ha' := ha.eq_or_lt,
  { rw zero_add at hab,
    rwa [zero_smul, zero_add, hab, one_smul] },
  rw mem_Iio at hx hy,
  calc
    a • x + b • y
        < a • r + b • r
        : add_lt_add_of_lt_of_le (smul_lt_smul_of_pos hx ha') (smul_le_smul_of_nonneg hy.le hb)
    ... = r : convex.combo_self hab _
end

lemma convex_Ioi (r : β) : convex 𝕜 (Ioi r) := @convex_Iio 𝕜 βᵒᵈ _ _ _ _ r

lemma convex_Ioo (r s : β) : convex 𝕜 (Ioo r s) :=
Ioi_inter_Iio.subst ((convex_Ioi r).inter $ convex_Iio s)

lemma convex_Ico (r s : β) : convex 𝕜 (Ico r s) :=
Ici_inter_Iio.subst ((convex_Ici r).inter $ convex_Iio s)

lemma convex_Ioc (r s : β) : convex 𝕜 (Ioc r s) :=
Ioi_inter_Iic.subst ((convex_Ioi r).inter $ convex_Iic s)

lemma convex_halfspace_lt {f : E → β} (h : is_linear_map 𝕜 f) (r : β) :
  convex 𝕜 {w | f w < r} :=
(convex_Iio r).is_linear_preimage h

lemma convex_halfspace_gt {f : E → β} (h : is_linear_map 𝕜 f) (r : β) :
  convex 𝕜 {w | r < f w} :=
(convex_Ioi r).is_linear_preimage h

end ordered_cancel_add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid β] [module 𝕜 β] [ordered_smul 𝕜 β]

lemma convex_interval (r s : β) : convex 𝕜 (interval r s) :=
convex_Icc _ _

end linear_ordered_add_comm_monoid
end module
end add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E]
  [ordered_smul 𝕜 E] {s : set E} {f : E → β}

lemma monotone_on.convex_le (hf : monotone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | f x ≤ r} :=
λ x y hx hy a b ha hb hab, ⟨hs hx.1 hy.1 ha hb hab,
  (hf (hs hx.1 hy.1 ha hb hab) (max_rec' s hx.1 hy.1) (convex.combo_le_max x y ha hb hab)).trans
    (max_rec' _ hx.2 hy.2)⟩

lemma monotone_on.convex_lt (hf : monotone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | f x < r} :=
λ x y hx hy a b ha hb hab, ⟨hs hx.1 hy.1 ha hb hab,
  (hf (hs hx.1 hy.1 ha hb hab) (max_rec' s hx.1 hy.1) (convex.combo_le_max x y ha hb hab)).trans_lt
    (max_rec' _ hx.2 hy.2)⟩

lemma monotone_on.convex_ge (hf : monotone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | r ≤ f x} :=
@monotone_on.convex_le 𝕜 Eᵒᵈ βᵒᵈ _ _ _ _ _ _ _ hf.dual hs r

lemma monotone_on.convex_gt (hf : monotone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | r < f x} :=
@monotone_on.convex_lt 𝕜 Eᵒᵈ βᵒᵈ _ _ _ _ _ _ _ hf.dual hs r

lemma antitone_on.convex_le (hf : antitone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | f x ≤ r} :=
@monotone_on.convex_ge 𝕜 E βᵒᵈ _ _ _ _ _ _ _ hf hs r

lemma antitone_on.convex_lt (hf : antitone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | f x < r} :=
@monotone_on.convex_gt 𝕜 E βᵒᵈ _ _ _ _ _ _ _ hf hs r

lemma antitone_on.convex_ge (hf : antitone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | r ≤ f x} :=
@monotone_on.convex_le 𝕜 E βᵒᵈ _ _ _ _ _ _ _ hf hs r

lemma antitone_on.convex_gt (hf : antitone_on f s) (hs : convex 𝕜 s) (r : β) :
  convex 𝕜 {x ∈ s | r < f x} :=
@monotone_on.convex_lt 𝕜 E βᵒᵈ _ _ _ _ _ _ _ hf hs r

lemma monotone.convex_le (hf : monotone f) (r : β) :
  convex 𝕜 {x | f x ≤ r} :=
set.sep_univ.subst ((hf.monotone_on univ).convex_le convex_univ r)

lemma monotone.convex_lt (hf : monotone f) (r : β) :
  convex 𝕜 {x | f x ≤ r} :=
set.sep_univ.subst ((hf.monotone_on univ).convex_le convex_univ r)

lemma monotone.convex_ge (hf : monotone f ) (r : β) :
  convex 𝕜 {x | r ≤ f x} :=
set.sep_univ.subst ((hf.monotone_on univ).convex_ge convex_univ r)

lemma monotone.convex_gt (hf : monotone f) (r : β) :
  convex 𝕜 {x | f x ≤ r} :=
set.sep_univ.subst ((hf.monotone_on univ).convex_le convex_univ r)

lemma antitone.convex_le (hf : antitone f) (r : β) :
  convex 𝕜 {x | f x ≤ r} :=
set.sep_univ.subst ((hf.antitone_on univ).convex_le convex_univ r)

lemma antitone.convex_lt (hf : antitone f) (r : β) :
  convex 𝕜 {x | f x < r} :=
set.sep_univ.subst ((hf.antitone_on univ).convex_lt convex_univ r)

lemma antitone.convex_ge (hf : antitone f) (r : β) :
  convex 𝕜 {x | r ≤ f x} :=
set.sep_univ.subst ((hf.antitone_on univ).convex_ge convex_univ r)

lemma antitone.convex_gt (hf : antitone f) (r : β) :
  convex 𝕜 {x | r < f x} :=
set.sep_univ.subst ((hf.antitone_on univ).convex_gt convex_univ r)

end linear_ordered_add_comm_monoid

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

lemma convex.combo_eq_vadd {a b : 𝕜} {x y : E} (h : a + b = 1) :
  a • x + b • y = b • (y - x) + x :=
calc
  a • x + b • y = (b • y - b • x) + (a • x + b • x) : by abel
            ... = b • (y - x) + x                   : by rw [smul_sub, convex.combo_self h]

end add_comm_group
end ordered_semiring

section ordered_comm_semiring
variables [ordered_comm_semiring 𝕜]

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

lemma convex.smul (hs : convex 𝕜 s) (c : 𝕜) : convex 𝕜 (c • s) :=
hs.linear_image (linear_map.lsmul _ _ c)

lemma convex.smul_preimage (hs : convex 𝕜 s) (c : 𝕜) : convex 𝕜 ((λ z, c • z) ⁻¹' s) :=
hs.linear_preimage (linear_map.lsmul _ _ c)

lemma convex.affinity (hs : convex 𝕜 s) (z : E) (c : 𝕜) : convex 𝕜 ((λ x, z + c • x) '' s) :=
by simpa only [←image_smul, ←image_vadd, image_image] using (hs.smul c).vadd z

end add_comm_monoid
end ordered_comm_semiring

section ordered_ring
variables [ordered_ring 𝕜]

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

lemma convex.add_smul_mem (hs : convex 𝕜 s) {x y : E} (hx : x ∈ s) (hy : x + y ∈ s)
  {t : 𝕜} (ht : t ∈ Icc (0 : 𝕜) 1) : x + t • y ∈ 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,
  exact hs hx hy (sub_nonneg_of_le ht.2) ht.1 (sub_add_cancel _ _),
end

lemma convex.smul_mem_of_zero_mem (hs : convex 𝕜 s) {x : E} (zero_mem : (0 : E) ∈ s) (hx : x ∈ s)
  {t : 𝕜} (ht : t ∈ Icc (0 : 𝕜) 1) : t • x ∈ s :=
by simpa using hs.add_smul_mem zero_mem (by simpa using hx) ht

lemma convex.add_smul_sub_mem (h : convex 𝕜 s) {x y : E} (hx : x ∈ s) (hy : y ∈ s)
  {t : 𝕜} (ht : t ∈ Icc (0 : 𝕜) 1) : x + t • (y - x) ∈ s :=
begin
  apply h.segment_subset hx hy,
  rw segment_eq_image',
  exact mem_image_of_mem _ ht,
end

/-- Affine subspaces are convex. -/
lemma affine_subspace.convex (Q : affine_subspace 𝕜 E) : convex 𝕜 (Q : set E) :=
begin
  intros x y hx hy a b ha hb hab,
  rw [eq_sub_of_add_eq hab, ← affine_map.line_map_apply_module],
  exact affine_map.line_map_mem b hx hy,
end

/--
Applying an affine map to an affine combination of two points yields
an affine combination of the images.
-/
lemma convex.combo_affine_apply {a b : 𝕜} {x y : E} {f : E →ᵃ[𝕜] F} (h : a + b = 1) :
  f (a • x + b • y) = a • f x + b • f y :=
begin
  simp only [convex.combo_eq_vadd h, ← vsub_eq_sub],
  exact f.apply_line_map _ _ _,
end

/-- The preimage of a convex set under an affine map is convex. -/
lemma convex.affine_preimage (f : E →ᵃ[𝕜] F) {s : set F} (hs : convex 𝕜 s) :
  convex 𝕜 (f ⁻¹' s) :=
begin
  intros x y xs ys a b ha hb hab,
  rw [mem_preimage, convex.combo_affine_apply hab],
  exact hs xs ys ha hb hab,
end

/-- The image of a convex set under an affine map is convex. -/
lemma convex.affine_image (f : E →ᵃ[𝕜] F) (hs : convex 𝕜 s) : convex 𝕜 (f '' s) :=
begin
  rintro x y ⟨x', ⟨hx', hx'f⟩⟩ ⟨y', ⟨hy', hy'f⟩⟩ a b ha hb hab,
  refine ⟨a • x' + b • y', ⟨hs hx' hy' ha hb hab, _⟩⟩,
  rw [convex.combo_affine_apply hab, hx'f, hy'f]
end

lemma convex.neg (hs : convex 𝕜 s) : convex 𝕜 (-s) :=
hs.is_linear_preimage is_linear_map.is_linear_map_neg

lemma convex.sub (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s - t) :=
by { rw sub_eq_add_neg, exact hs.add ht.neg }

end add_comm_group
end ordered_ring

section linear_ordered_field
variables [linear_ordered_field 𝕜]

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

/-- Alternative definition of set convexity, using division. -/
lemma convex_iff_div :
  convex 𝕜 s ↔ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄,
    0 ≤ a → 0 ≤ b → 0 < a + b → (a / (a + b)) • x + (b / (a + b)) • y ∈ s :=
begin
  simp only [convex_iff_segment_subset, subset_def, mem_segment_iff_div],
  refine forall₄_congr (λ x y hx hy, ⟨λ H a b ha hb hab, H _ ⟨a, b, ha, hb, hab, rfl⟩, _⟩),
  rintro H _ ⟨a, b, ha, hb, hab, rfl⟩,
  exact H ha hb hab
end

lemma convex.mem_smul_of_zero_mem (h : convex 𝕜 s) {x : E} (zero_mem : (0 : E) ∈ s)
  (hx : x ∈ s) {t : 𝕜} (ht : 1 ≤ t) :
  x ∈ t • s :=
begin
  rw mem_smul_set_iff_inv_smul_mem₀ (zero_lt_one.trans_le ht).ne',
  exact h.smul_mem_of_zero_mem zero_mem hx ⟨inv_nonneg.2 (zero_le_one.trans ht), inv_le_one ht⟩,
end

lemma convex.add_smul (h_conv : convex 𝕜 s) {p q : 𝕜} (hp : 0 ≤ p) (hq : 0 ≤ q) :
  (p + q) • s = p • s + q • s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { simp_rw [smul_set_empty, add_empty] },
  obtain rfl | hp' := hp.eq_or_lt,
  { rw [zero_add, zero_smul_set hs, zero_add] },
  obtain rfl | hq' := hq.eq_or_lt,
  { rw [add_zero, zero_smul_set hs, add_zero] },
  ext,
  split,
  { rintro ⟨v, hv, rfl⟩,
    exact ⟨p • v, q • v, smul_mem_smul_set hv, smul_mem_smul_set hv, (add_smul _ _ _).symm⟩ },
  { rintro ⟨v₁, v₂, ⟨v₁₁, h₁₂, rfl⟩, ⟨v₂₁, h₂₂, rfl⟩, rfl⟩,
    have hpq := add_pos hp' hq',
    exact mem_smul_set.2 ⟨_, h_conv h₁₂ h₂₂ (div_pos hp' hpq).le (div_pos hq' hpq).le
      (by rw [←div_self hpq.ne', add_div] : p / (p + q) + q / (p + q) = 1),
      by simp only [← mul_smul, smul_add, mul_div_cancel' _ hpq.ne']⟩ }
end

end add_comm_group
end linear_ordered_field

/-!
#### Convex sets in an ordered space
Relates `convex` and `ord_connected`.
-/

section

lemma set.ord_connected.convex_of_chain [ordered_semiring 𝕜] [ordered_add_comm_monoid E]
  [module 𝕜 E] [ordered_smul 𝕜 E] {s : set E} (hs : s.ord_connected) (h : is_chain (≤) s) :
  convex 𝕜 s :=
begin
  refine convex_iff_segment_subset.mpr (λ x y hx hy, _),
  obtain hxy | hyx := h.total hx hy,
  { exact (segment_subset_Icc hxy).trans (hs.out hx hy) },
  { rw segment_symm,
    exact (segment_subset_Icc hyx).trans (hs.out hy hx) }
end

lemma set.ord_connected.convex [ordered_semiring 𝕜] [linear_ordered_add_comm_monoid E] [module 𝕜 E]
  [ordered_smul 𝕜 E] {s : set E} (hs : s.ord_connected) :
  convex 𝕜 s :=
hs.convex_of_chain $ is_chain_of_trichotomous s

lemma convex_iff_ord_connected [linear_ordered_field 𝕜] {s : set 𝕜} :
  convex 𝕜 s ↔ s.ord_connected :=
begin
  simp_rw [convex_iff_segment_subset, segment_eq_interval, ord_connected_iff_interval_subset],
  exact forall_congr (λ x, forall_swap)
end

alias convex_iff_ord_connected ↔ convex.ord_connected _

end

/-! #### Convexity of submodules/subspaces -/

section submodule
open submodule

lemma submodule.convex [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] (K : submodule 𝕜 E) :
  convex 𝕜 (↑K : set E) :=
by { repeat {intro}, refine add_mem (smul_mem _ _ _) (smul_mem _ _ _); assumption }

lemma subspace.convex [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] (K : subspace 𝕜 E) :
  convex 𝕜 (↑K : set E) :=
K.convex

end submodule

/-! ### Simplex -/

section simplex

variables (𝕜) (ι : Type*) [ordered_semiring 𝕜] [fintype ι]

/-- The standard simplex in the space of functions `ι → 𝕜` is the set of vectors with non-negative
coordinates with total sum `1`. This is the free object in the category of convex spaces. -/
def std_simplex : set (ι → 𝕜) :=
{f | (∀ x, 0 ≤ f x) ∧ ∑ x, f x = 1}

lemma std_simplex_eq_inter :
  std_simplex 𝕜 ι = (⋂ x, {f | 0 ≤ f x}) ∩ {f | ∑ x, f x = 1} :=
by { ext f, simp only [std_simplex, set.mem_inter_eq, set.mem_Inter, set.mem_set_of_eq] }

lemma convex_std_simplex : convex 𝕜 (std_simplex 𝕜 ι) :=
begin
  refine λ f g hf hg a b ha hb hab, ⟨λ x, _, _⟩,
  { apply_rules [add_nonneg, mul_nonneg, hf.1, hg.1] },
  { erw [finset.sum_add_distrib, ← finset.smul_sum, ← finset.smul_sum, hf.2, hg.2,
      smul_eq_mul, smul_eq_mul, mul_one, mul_one],
    exact hab }
end

variable {ι}

lemma ite_eq_mem_std_simplex (i : ι) : (λ j, ite (i = j) (1:𝕜) 0) ∈ std_simplex 𝕜 ι :=
⟨λ j, by simp only; split_ifs; norm_num, by rw [finset.sum_ite_eq, if_pos (finset.mem_univ _)]⟩

end simplex


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.intervals.unordered_interval
import data.set.lattice

/-!
# Order-connected sets

We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α = ℝ`, then
this condition is also equivalent to `convex s`.

In this file we prove that intersection of a family of `ord_connected` sets is `ord_connected` and
that all standard intervals are `ord_connected`.
-/

namespace set

variables {α : Type*} [preorder α] {s t : set α}

/--
We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α = ℝ`, then
this condition is also equivalent to `convex s`.
-/
class ord_connected (s : set α) : Prop :=
(out' ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) : Icc x y ⊆ s)

lemma ord_connected.out (h : ord_connected s) :
  ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), Icc x y ⊆ s := h.1

lemma ord_connected_def : ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), Icc x y ⊆ s :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- It suffices to prove `[x, y] ⊆ s` for `x y ∈ s`, `x ≤ y`. -/
lemma ord_connected_iff : ord_connected s ↔ ∀ (x ∈ s) (y ∈ s), x ≤ y → Icc x y ⊆ s :=
ord_connected_def.trans
⟨λ hs x hx y hy hxy, hs hx hy, λ H x hx y hy z hz, H x hx y hy (le_trans hz.1 hz.2) hz⟩

lemma ord_connected_of_Ioo {α : Type*} [partial_order α] {s : set α}
  (hs : ∀ (x ∈ s) (y ∈ s), x < y → Ioo x y ⊆ s) :
  ord_connected s :=
begin
  rw ord_connected_iff,
  intros x hx y hy hxy,
  rcases eq_or_lt_of_le hxy with rfl|hxy', { simpa },
  have := hs x hx y hy hxy',
  rw [← union_diff_cancel Ioo_subset_Icc_self],
  simp [*, insert_subset]
end

protected lemma Icc_subset (s : set α) [hs : ord_connected s] {x y} (hx : x ∈ s) (hy : y ∈ s) :
  Icc x y ⊆ s := hs.out hx hy

lemma ord_connected.inter {s t : set α} (hs : ord_connected s) (ht : ord_connected t) :
  ord_connected (s ∩ t) :=
⟨λ x hx y hy, subset_inter (hs.out hx.1 hy.1) (ht.out hx.2 hy.2)⟩

instance ord_connected.inter' {s t : set α} [ord_connected s] [ord_connected t] :
  ord_connected (s ∩ t) :=
ord_connected.inter ‹_› ‹_›

lemma ord_connected.dual {s : set α} (hs : ord_connected s) : @ord_connected (order_dual α) _ s :=
⟨λ x hx y hy z hz, hs.out hy hx ⟨hz.2, hz.1⟩⟩

lemma ord_connected_dual {s : set α} : @ord_connected (order_dual α) _ s ↔ ord_connected s :=
⟨λ h, by simpa only [ord_connected_def] using h.dual, λ h, h.dual⟩

lemma ord_connected_sInter {S : set (set α)} (hS : ∀ s ∈ S, ord_connected s) :
  ord_connected (⋂₀ S) :=
⟨λ x hx y hy, subset_sInter $ λ s hs, (hS s hs).out (hx s hs) (hy s hs)⟩

lemma ord_connected_Inter {ι : Sort*} {s : ι → set α} (hs : ∀ i, ord_connected (s i)) :
  ord_connected (⋂ i, s i) :=
ord_connected_sInter $ forall_range_iff.2 hs

instance ord_connected_Inter' {ι : Sort*} {s : ι → set α} [∀ i, ord_connected (s i)] :
  ord_connected (⋂ i, s i) :=
ord_connected_Inter ‹_›

lemma ord_connected_bInter {ι : Sort*} {p : ι → Prop} {s : Π (i : ι) (hi : p i), set α}
  (hs : ∀ i hi, ord_connected (s i hi)) :
  ord_connected (⋂ i hi, s i hi) :=
ord_connected_Inter $ λ i, ord_connected_Inter $ hs i

lemma ord_connected_pi {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s : set ι}
  {t : Π i, set (α i)} (h : ∀ i ∈ s, ord_connected (t i)) : ord_connected (s.pi t) :=
⟨λ x hx y hy z hz i hi, (h i hi).out (hx i hi) (hy i hi) ⟨hz.1 i, hz.2 i⟩⟩

instance ord_connected_pi' {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s : set ι}
  {t : Π i, set (α i)} [h : ∀ i, ord_connected (t i)] : ord_connected (s.pi t) :=
ord_connected_pi $ λ i hi, h i

@[instance] lemma ord_connected_Ici {a : α} : ord_connected (Ici a) :=
⟨λ x hx y hy z hz, le_trans hx hz.1⟩

@[instance] lemma ord_connected_Iic {a : α} : ord_connected (Iic a) :=
⟨λ x hx y hy z hz, le_trans hz.2 hy⟩

@[instance] lemma ord_connected_Ioi {a : α} : ord_connected (Ioi a) :=
⟨λ x hx y hy z hz, lt_of_lt_of_le hx hz.1⟩

@[instance] lemma ord_connected_Iio {a : α} : ord_connected (Iio a) :=
⟨λ x hx y hy z hz, lt_of_le_of_lt hz.2 hy⟩

@[instance] lemma ord_connected_Icc {a b : α} : ord_connected (Icc a b) :=
ord_connected_Ici.inter ord_connected_Iic

@[instance] lemma ord_connected_Ico {a b : α} : ord_connected (Ico a b) :=
ord_connected_Ici.inter ord_connected_Iio

@[instance] lemma ord_connected_Ioc {a b : α} : ord_connected (Ioc a b) :=
ord_connected_Ioi.inter ord_connected_Iic

@[instance] lemma ord_connected_Ioo {a b : α} : ord_connected (Ioo a b) :=
ord_connected_Ioi.inter ord_connected_Iio

@[instance] lemma ord_connected_singleton {α : Type*} [partial_order α] {a : α} :
  ord_connected ({a} : set α) :=
by { rw ← Icc_self, exact ord_connected_Icc }

@[instance] lemma ord_connected_empty : ord_connected (∅ : set α) := ⟨λ x, false.elim⟩

@[instance] lemma ord_connected_univ : ord_connected (univ : set α) := ⟨λ _ _ _ _, subset_univ _⟩

/-- In a dense order `α`, the subtype from an `ord_connected` set is also densely ordered. -/
instance [densely_ordered α] {s : set α} [hs : ord_connected s] :
  densely_ordered s :=
⟨ begin
    intros a₁ a₂ ha,
    have ha' : ↑a₁ < ↑a₂ := ha,
    obtain ⟨x, ha₁x, hxa₂⟩ := exists_between ha',
    refine ⟨⟨x, _⟩, ⟨ha₁x, hxa₂⟩⟩,
    exact (hs.out a₁.2 a₂.2) (Ioo_subset_Icc_self ⟨ha₁x, hxa₂⟩),
  end ⟩

variables {β : Type*} [linear_order β]

@[instance] lemma ord_connected_interval {a b : β} : ord_connected (interval a b) :=
ord_connected_Icc

lemma ord_connected.interval_subset {s : set β} (hs : ord_connected s)
  ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) :
  interval x y ⊆ s :=
by cases le_total x y; simp only [interval_of_le, interval_of_ge, *]; apply hs.out; assumption

lemma ord_connected_iff_interval_subset {s : set β} :
  ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), interval x y ⊆ s :=
⟨λ h, h.interval_subset,
  λ h, ord_connected_iff.2 $ λ x hx y hy hxy, by simpa only [interval_of_le hxy] using h hx hy⟩

end set


import Std.Data.List.Lemmas

namespace Data
section
  inductive BinaryTree.{u} (type : Type u)
  | nil
  | node (value : type) (left right : BinaryTree type)
end

namespace BinaryTree
section
  def height {type} : BinaryTree type → Nat
  | nil => 0
  | node _ left right => max left.height right.height + 1

  def nodeCount {type} : BinaryTree type → Nat
  | nil => 0
  | node _ left right => left.nodeCount + right.nodeCount + 1

  def infixList {type} : BinaryTree type → List type
  | nil => []
  | node value left right => left.infixList ++ value :: right.infixList
end

section
  inductive Mem {type} : type → BinaryTree type → Prop
  | eq {value left right x} : x = value → Mem x (node value left right)
  | left {value left right x} : Mem x left → Mem x (node value left right)
  | right {value left right x} : Mem x right → Mem x (node value left right)

  instance {type} : Membership type (BinaryTree type) where
    mem := Mem
end

section
  open List

  theorem Mem.infixList_of_Mem {type} {x} {tree : BinaryTree type} (h : x ∈ tree)
    : x ∈ tree.infixList := by
    induction tree with
    | nil => contradiction
    | node value _ _ left_rec right_rec =>
      show _ ∈ _ ++ _ :: _
      rw [mem_append, mem_cons]
      cases h with
      | left h => simp [left_rec h]
      | eq h => simp [h]
      | right h => simp [right_rec h]

  theorem Mem.of_Mem_infixList {type} {x} {tree : BinaryTree type} (h : x ∈ tree.infixList)
    : x ∈ tree := by
    induction tree with
    | nil => contradiction
    | node _ _ _ left_rec right_rec =>
      have h : _ ∈ _ ++ _ :: _ := h
      rw [mem_append, mem_cons] at h
      rcases h with h | h | h
      . exact left (left_rec h)
      . exact eq h
      . exact right (right_rec h)
end

section
  theorem Mem_iff_Mem_infixList {type} (x) (tree : BinaryTree type) : x ∈ tree ↔ x ∈ tree.infixList := by
    constructor
    . exact Mem.infixList_of_Mem
    . exact Mem.of_Mem_infixList

  theorem forall_iff_forall_infixList (tree : BinaryTree type) (p : type → Prop)
    : (∀ x ∈ tree, p x) ↔ (∀ x ∈ tree.infixList, p x) :=
    ⟨λ h x => (h x) ∘ Mem.of_Mem_infixList, λ h x => (h x) ∘ Mem.infixList_of_Mem⟩

  instance decidableMem {type} [DecidableEq type] (x) (tree : BinaryTree type)
    : Decidable (x ∈ tree) :=
    match tree with
    | nil => isFalse λ.
    | node value left right =>
      let this := decidableMem x left
      let this := decidableMem x right
      if h_eq : x = value then isTrue $ Mem.eq h_eq
      else if h_left : x ∈ left then isTrue h_left.left
      else if h_right : x ∈ right then isTrue h_right.right
      else isFalse λ
        | .eq h => h_eq h
        | .left h => h_left h
        | .right h => h_right h
end

section
  inductive LeftOrRight | left | right

  inductive IsExternalLeaf : BinaryTree type → List LeftOrRight → Prop
  | base : IsExternalLeaf .nil .nil
  | left : IsExternalLeaf tree l → IsExternalLeaf (.node value tree right) (.left :: l)
  | right : IsExternalLeaf tree l → IsExternalLeaf (.node value left tree) (.right :: l)

  def ExternalLeaf (tree : BinaryTree type) := { path : List LeftOrRight // tree.IsExternalLeaf path }

  inductive IsInternalLeaf : BinaryTree type → List LeftOrRight → Prop
  | base : IsInternalLeaf (.node value .nil .nil) .nil
  | left : IsInternalLeaf (.node value left right) l
    → IsInternalLeaf (.node new_value (.node value left right) new_right) (.left :: l)
  | right : IsInternalLeaf (.node value left right) l
    → IsInternalLeaf (.node new_value new_left (.node value left right)) (.right :: l)

  def InternalLeaf (tree : BinaryTree type) := { path : List LeftOrRight // tree.IsInternalLeaf path }

  inductive IsInternalPath : BinaryTree type → List LeftOrRight → Prop
  | base : IsInternalPath (.node value left right) .nil
  | left : IsInternalPath (.node value left right) l
    → IsInternalPath (.node new_value (.node value left right) new_right) (.left :: l)
  | right : IsInternalPath (.node value left right) l
    → IsInternalPath (.node new_value new_left (.node value left right)) (.right :: l)

  def InternalPath (tree : BinaryTree type) := { path : List LeftOrRight // tree.IsInternalPath path }

  theorem List.eq_dropLast_append_getLast (l : List α) (hl : l ≠ []) : l = l.dropLast ++ [l.getLast hl] :=
    match l with
    | [_] => rfl
    | _ :: b :: l => congrArg _ <| eq_dropLast_append_getLast (b :: l) (λ.)

  def getParent (tree : BinaryTree type) (path : InternalPath tree) (h : path.val ≠ [])
    : InternalPath tree :=
    ⟨path.val.dropLast, r tree path.val.dropLast (List.eq_dropLast_append_getLast path.val h ▸ path.property)⟩
    where r tree path {e} (isPath : tree.IsInternalPath (path ++ [e])) : tree.IsInternalPath path :=
      match tree, path, isPath with
      | .node .., [], _ => .base
      | .node _ (.node ..) _, [.left], .left _ => .left .base
      | .node _ (.node ..) _, .left :: a :: l, .left isPath =>
        .left <| r _ (a :: l) isPath
      | .node _ _ (.node ..), [.right], .right _ => .right .base
      | .node _ _ (.node ..), .right :: a :: l, .right isPath =>
        .right <| r _ (a :: l) isPath

  def InternalLeaf.toPath {tree : BinaryTree type} (path : InternalLeaf tree) : InternalPath tree :=
    ⟨path.val, r tree path.val path.property⟩
    where r tree path isPath : tree.IsInternalPath path :=
      match tree, path with
      | .node _ .nil .nil, .nil => .base
      | .node _ (.node ..) _, .left :: path => .left <| r _ path (match isPath with | .left h => h)
      | .node _ _ (.node ..), .right :: path => .right <| r _ path (match isPath with | .right h => h)

  def getTreeAt (tree : BinaryTree type) (path : InternalPath tree) : BinaryTree type :=
    r tree path.val path.property
    where r tree path isPath :=
      match tree, path with
      | .node value left right, [] => .node value left right
      | .node _ left _, .left :: path =>
        r left path (match isPath with | .left h => h)
      | .node _ _ right, .right :: path =>
        r right path (match isPath with | .right h => h)

  def insertTreeAt (tree : BinaryTree type) (path : ExternalLeaf tree) (new : BinaryTree type)
    : BinaryTree type :=
    r tree path.val path.property new
    where r tree path isPath new :=
      match tree, path with
      | .nil, [] => new
      | .node value left right, .left :: path =>
        .node value (r left path (match isPath with | .left h => h) new) right
      | .node value left right, .right :: path =>
        .node value left (r right path (match isPath with | .right h => h) new)

  def removeTreeAt (tree : BinaryTree type) (path : InternalPath tree)
    : BinaryTree type :=
    r tree path.val path.property
    where r tree path isPath :=
      match tree, path with
      | .node .., [] => .nil
      | .node value left right, .left :: path =>
        .node value (r left path (match isPath with | .left h => h)) right
      | .node value left right, .right :: path =>
        .node value left (r right path (match isPath with | .right h => h))

  def externalLeafOfRemoveTreeAt (tree : BinaryTree type) (path : InternalPath tree)
    : ExternalLeaf (tree.removeTreeAt path) :=
    ⟨path.val, r tree path.val path.property⟩
    where r tree path (isPath : IsInternalPath tree path) : (tree.removeTreeAt ⟨path, isPath⟩).IsExternalLeaf path :=
      match tree, path with
      | .node .., [] => .base
      | .node _ left _, .left :: path =>
        .left <| r left path (match isPath with | .left h => h)
      | .node _ _ right, .right :: path =>
        .right <| r right path (match isPath with | .right h => h)

  def replaceTreeAt (tree : BinaryTree type) (path : InternalPath tree) (new : BinaryTree type)
    : BinaryTree type :=
    (tree.removeTreeAt path).insertTreeAt (tree.externalLeafOfRemoveTreeAt path) new

end

end BinaryTree
end Data


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Yury Kudryashov
-/
import data.real.sqrt
import tactic.interval_cases
import ring_theory.algebraic
import data.rat.sqrt
import data.polynomial.eval
import ring_theory.int.basic
/-!
# Irrational real numbers

In this file we define a predicate `irrational` on `ℝ`, prove that the `n`-th root of an integer
number is irrational if it is not integer, and that `sqrt q` is irrational if and only if
`rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q`.

We also provide dot-style constructors like `irrational.add_rat`, `irrational.rat_sub` etc.
-/

open rat real multiplicity

/-- A real number is irrational if it is not equal to any rational number. -/
def irrational (x : ℝ) := x ∉ set.range (coe : ℚ → ℝ)

lemma irrational_iff_ne_rational (x : ℝ) : irrational x ↔ ∀ a b : ℤ, x ≠ a / b :=
by simp only [irrational, rat.forall, cast_mk, not_exists, set.mem_range, cast_coe_int, cast_div,
  eq_comm]

/-- A transcendental real number is irrational. -/
lemma transcendental.irrational {r : ℝ} (tr : transcendental ℚ r) :
  irrational r :=
by { rintro ⟨a, rfl⟩, exact tr (is_algebraic_algebra_map a) }

/-!
### Irrationality of roots of integer and rational numbers
-/

/-- If `x^n`, `n > 0`, is integer and is not the `n`-th power of an integer, then
`x` is irrational. -/
theorem irrational_nrt_of_notint_nrt {x : ℝ} (n : ℕ) (m : ℤ)
  (hxr : x ^ n = m) (hv : ¬ ∃ y : ℤ, x = y) (hnpos : 0 < n) :
  irrational x :=
begin
  rintros ⟨⟨N, D, P, C⟩, rfl⟩,
  rw [← cast_pow] at hxr,
  have c1 : ((D : ℤ) : ℝ) ≠ 0,
  { rw [int.cast_ne_zero, int.coe_nat_ne_zero], exact ne_of_gt P },
  have c2 : ((D : ℤ) : ℝ) ^ n ≠ 0 := pow_ne_zero _ c1,
  rw [num_denom', cast_pow, cast_mk, div_pow, div_eq_iff_mul_eq c2,
      ← int.cast_pow, ← int.cast_pow, ← int.cast_mul, int.cast_inj] at hxr,
  have hdivn : ↑D ^ n ∣ N ^ n := dvd.intro_left m hxr,
  rw [← int.dvd_nat_abs, ← int.coe_nat_pow, int.coe_nat_dvd, int.nat_abs_pow,
    nat.pow_dvd_pow_iff hnpos] at hdivn,
  have hD : D = 1 := by rw [← nat.gcd_eq_right hdivn, C.gcd_eq_one],
  subst D,
  refine hv ⟨N, _⟩,
  rw [num_denom', int.coe_nat_one, mk_eq_div, int.cast_one, div_one, cast_coe_int]
end

/-- If `x^n = m` is an integer and `n` does not divide the `multiplicity p m`, then `x`
is irrational. -/
theorem irrational_nrt_of_n_not_dvd_multiplicity {x : ℝ} (n : ℕ) {m : ℤ} (hm : m ≠ 0) (p : ℕ)
  [hp : fact p.prime] (hxr : x ^ n = m)
  (hv : (multiplicity (p : ℤ) m).get (finite_int_iff.2 ⟨hp.1.ne_one, hm⟩) % n ≠ 0) :
  irrational x :=
begin
  rcases nat.eq_zero_or_pos n with rfl | hnpos,
  { rw [eq_comm, pow_zero, ← int.cast_one, int.cast_inj] at hxr,
    simpa [hxr, multiplicity.one_right (mt is_unit_iff_dvd_one.1
      (mt int.coe_nat_dvd.1 hp.1.not_dvd_one)), nat.zero_mod] using hv },
  refine irrational_nrt_of_notint_nrt _ _ hxr _ hnpos,
  rintro ⟨y, rfl⟩,
  rw [← int.cast_pow, int.cast_inj] at hxr, subst m,
  have : y ≠ 0, { rintro rfl, rw zero_pow hnpos at hm, exact hm rfl },
  erw [multiplicity.pow' (nat.prime_iff_prime_int.1 hp.1)
    (finite_int_iff.2 ⟨hp.1.ne_one, this⟩), nat.mul_mod_right] at hv,
  exact hv rfl
end

theorem irrational_sqrt_of_multiplicity_odd (m : ℤ) (hm : 0 < m)
  (p : ℕ) [hp : fact p.prime]
  (Hpv : (multiplicity (p : ℤ) m).get
    (finite_int_iff.2 ⟨hp.1.ne_one, (ne_of_lt hm).symm⟩) % 2 = 1) :
  irrational (sqrt m) :=
@irrational_nrt_of_n_not_dvd_multiplicity _ 2 _ (ne.symm (ne_of_lt hm)) p hp
  (sq_sqrt (int.cast_nonneg.2 $ le_of_lt hm))
  (by rw Hpv; exact one_ne_zero)

theorem nat.prime.irrational_sqrt {p : ℕ} (hp : nat.prime p) : irrational (sqrt p) :=
@irrational_sqrt_of_multiplicity_odd p (int.coe_nat_pos.2 hp.pos) p ⟨hp⟩ $
by simp [multiplicity_self (mt is_unit_iff_dvd_one.1 (mt int.coe_nat_dvd.1 hp.not_dvd_one) : _)];
  refl

/-- **Irrationality of the Square Root of 2** -/
theorem irrational_sqrt_two : irrational (sqrt 2) :=
by simpa using nat.prime_two.irrational_sqrt

theorem irrational_sqrt_rat_iff (q : ℚ) : irrational (sqrt q) ↔
  rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q :=
if H1 : rat.sqrt q * rat.sqrt q = q
then iff_of_false (not_not_intro ⟨rat.sqrt q,
  by rw [← H1, cast_mul, sqrt_mul_self (cast_nonneg.2 $ rat.sqrt_nonneg q),
         sqrt_eq, abs_of_nonneg (rat.sqrt_nonneg q)]⟩) (λ h, h.1 H1)
else if H2 : 0 ≤ q
then iff_of_true (λ ⟨r, hr⟩, H1 $ (exists_mul_self _).1 ⟨r,
  by rwa [eq_comm, sqrt_eq_iff_mul_self_eq (cast_nonneg.2 H2), ← cast_mul, rat.cast_inj] at hr;
  rw [← hr]; exact real.sqrt_nonneg _⟩) ⟨H1, H2⟩
else iff_of_false (not_not_intro ⟨0,
  by rw cast_zero; exact (sqrt_eq_zero_of_nonpos (rat.cast_nonpos.2 $ le_of_not_le H2)).symm⟩)
  (λ h, H2 h.2)

instance (q : ℚ) : decidable (irrational (sqrt q)) :=
decidable_of_iff' _ (irrational_sqrt_rat_iff q)

/-!
### Dot-style operations on `irrational`

#### Coercion of a rational/integer/natural number is not irrational
-/

namespace irrational

variable {x : ℝ}

/-!
#### Irrational number is not equal to a rational/integer/natural number
-/

theorem ne_rat (h : irrational x) (q : ℚ) : x ≠ q := λ hq, h ⟨q, hq.symm⟩

theorem ne_int (h : irrational x) (m : ℤ) : x ≠ m :=
by { rw ← rat.cast_coe_int, exact h.ne_rat _ }

theorem ne_nat (h : irrational x) (m : ℕ) : x ≠ m := h.ne_int m

theorem ne_zero (h : irrational x) : x ≠ 0 := h.ne_nat 0

theorem ne_one (h : irrational x) : x ≠ 1 := by simpa only [nat.cast_one] using h.ne_nat 1

end irrational

@[simp] lemma rat.not_irrational (q : ℚ) : ¬irrational q := λ h, h ⟨q, rfl⟩

@[simp] lemma int.not_irrational (m : ℤ) : ¬irrational m := λ h, h.ne_int m rfl

@[simp] lemma nat.not_irrational (m : ℕ) : ¬irrational m := λ h, h.ne_nat m rfl

namespace irrational

variables (q : ℚ) {x y : ℝ}

/-!
#### Addition of rational/integer/natural numbers
-/

/-- If `x + y` is irrational, then at least one of `x` and `y` is irrational. -/
theorem add_cases : irrational (x + y) → irrational x ∨ irrational y :=
begin
  delta irrational,
  contrapose!,
  rintros ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩,
  exact ⟨rx + ry, cast_add rx ry⟩
end

theorem of_rat_add (h : irrational (q + x)) : irrational x :=
h.add_cases.resolve_left q.not_irrational

theorem rat_add (h : irrational x) : irrational (q + x) :=
of_rat_add (-q) $ by rwa [cast_neg, neg_add_cancel_left]

theorem of_add_rat : irrational (x + q) → irrational x :=
add_comm ↑q x ▸ of_rat_add q

theorem add_rat (h : irrational x) : irrational (x + q) :=
add_comm ↑q x ▸ h.rat_add q

theorem of_int_add (m : ℤ) (h : irrational (m + x)) : irrational x :=
by { rw ← cast_coe_int at h, exact h.of_rat_add m }

theorem of_add_int (m : ℤ) (h : irrational (x + m)) : irrational x :=
of_int_add m $ add_comm x m ▸ h

theorem int_add (h : irrational x) (m : ℤ) : irrational (m + x) :=
by { rw ← cast_coe_int, exact h.rat_add m }

theorem add_int (h : irrational x) (m : ℤ) : irrational (x + m) :=
add_comm ↑m x ▸ h.int_add m

theorem of_nat_add (m : ℕ) (h : irrational (m + x)) : irrational x := h.of_int_add m

theorem of_add_nat (m : ℕ) (h : irrational (x + m)) : irrational x := h.of_add_int m

theorem nat_add (h : irrational x) (m : ℕ) : irrational (m + x) := h.int_add m

theorem add_nat (h : irrational x) (m : ℕ) : irrational (x + m) := h.add_int m

/-!
#### Negation
-/

theorem of_neg (h : irrational (-x)) : irrational x :=
λ ⟨q, hx⟩, h ⟨-q, by rw [cast_neg, hx]⟩

protected theorem neg (h : irrational x) : irrational (-x) :=
of_neg $ by rwa neg_neg

/-!
#### Subtraction of rational/integer/natural numbers
-/

theorem sub_rat (h : irrational x) : irrational (x - q) :=
by simpa only [sub_eq_add_neg, cast_neg] using h.add_rat (-q)

theorem rat_sub (h : irrational x) : irrational (q - x) :=
by simpa only [sub_eq_add_neg] using h.neg.rat_add q

theorem of_sub_rat (h : irrational (x - q)) : irrational x :=
(of_add_rat (-q) $ by simpa only [cast_neg, sub_eq_add_neg] using h)

theorem of_rat_sub (h : irrational (q - x)) : irrational x :=
of_neg (of_rat_add q (by simpa only [sub_eq_add_neg] using h))

theorem sub_int (h : irrational x) (m : ℤ) : irrational (x - m) :=
by simpa only [rat.cast_coe_int] using h.sub_rat m

theorem int_sub (h : irrational x) (m : ℤ) : irrational (m - x) :=
by simpa only [rat.cast_coe_int] using h.rat_sub m

theorem of_sub_int (m : ℤ) (h : irrational (x - m)) : irrational x :=
of_sub_rat m $ by rwa rat.cast_coe_int

theorem of_int_sub (m : ℤ) (h : irrational (m - x)) : irrational x :=
of_rat_sub m $ by rwa rat.cast_coe_int

theorem sub_nat (h : irrational x) (m : ℕ) : irrational (x - m) := h.sub_int m

theorem nat_sub (h : irrational x) (m : ℕ) : irrational (m - x) := h.int_sub m

theorem of_sub_nat (m : ℕ) (h : irrational (x - m)) : irrational x := h.of_sub_int m

theorem of_nat_sub (m : ℕ) (h : irrational (m - x)) : irrational x := h.of_int_sub m

/-!
#### Multiplication by rational numbers
-/

theorem mul_cases : irrational (x * y) → irrational x ∨ irrational y :=
begin
  delta irrational,
  contrapose!,
  rintros ⟨⟨rx, rfl⟩, ⟨ry, rfl⟩⟩,
  exact ⟨rx * ry, cast_mul rx ry⟩
end

theorem of_mul_rat (h : irrational (x * q)) : irrational x :=
h.mul_cases.resolve_right q.not_irrational

theorem mul_rat (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (x * q) :=
of_mul_rat q⁻¹ $ by rwa [mul_assoc, ← cast_mul, mul_inv_cancel hq, cast_one, mul_one]

theorem of_rat_mul : irrational (q * x) → irrational x :=
mul_comm x q ▸ of_mul_rat q

theorem rat_mul (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (q * x) :=
mul_comm x q ▸ h.mul_rat hq

theorem of_mul_int (m : ℤ) (h : irrational (x * m)) : irrational x :=
of_mul_rat m $ by rwa cast_coe_int

theorem of_int_mul (m : ℤ) (h : irrational (m * x)) : irrational x :=
of_rat_mul m $ by rwa cast_coe_int

theorem mul_int (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (x * m) :=
by { rw ← cast_coe_int, refine h.mul_rat _, rwa int.cast_ne_zero }

theorem int_mul (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (m * x) :=
mul_comm x m ▸ h.mul_int hm

theorem of_mul_nat (m : ℕ) (h : irrational (x * m)) : irrational x := h.of_mul_int m

theorem of_nat_mul (m : ℕ) (h : irrational (m * x)) : irrational x := h.of_int_mul m

theorem mul_nat (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (x * m) :=
h.mul_int $ int.coe_nat_ne_zero.2 hm

theorem nat_mul (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (m * x) :=
h.int_mul $ int.coe_nat_ne_zero.2 hm

/-!
#### Inverse
-/

theorem of_inv (h : irrational x⁻¹) : irrational x :=
λ ⟨q, hq⟩, h $ hq ▸ ⟨q⁻¹, q.cast_inv⟩

protected theorem inv (h : irrational x) : irrational x⁻¹ :=
of_inv $ by rwa inv_inv₀

/-!
#### Division
-/

theorem div_cases (h : irrational (x / y)) : irrational x ∨ irrational y :=
h.mul_cases.imp id of_inv

theorem of_rat_div (h : irrational (q / x)) : irrational x :=
(h.of_rat_mul q).of_inv

theorem of_div_rat (h : irrational (x / q)) : irrational x :=
h.div_cases.resolve_right q.not_irrational

theorem rat_div (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (q / x) := h.inv.rat_mul hq

theorem div_rat (h : irrational x) {q : ℚ} (hq : q ≠ 0) : irrational (x / q) :=
by { rw [div_eq_mul_inv, ← cast_inv], exact h.mul_rat (inv_ne_zero hq) }

theorem of_int_div (m : ℤ) (h : irrational (m / x)) : irrational x :=
h.div_cases.resolve_left m.not_irrational

theorem of_div_int (m : ℤ) (h : irrational (x / m)) : irrational x :=
h.div_cases.resolve_right m.not_irrational

theorem int_div (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (m / x) :=
h.inv.int_mul hm

theorem div_int (h : irrational x) {m : ℤ} (hm : m ≠ 0) : irrational (x / m) :=
by { rw ← cast_coe_int, refine h.div_rat _, rwa int.cast_ne_zero }

theorem of_nat_div (m : ℕ) (h : irrational (m / x)) : irrational x := h.of_int_div m

theorem of_div_nat (m : ℕ) (h : irrational (x / m)) : irrational x := h.of_div_int m

theorem nat_div (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (m / x) := h.inv.nat_mul hm

theorem div_nat (h : irrational x) {m : ℕ} (hm : m ≠ 0) : irrational (x / m) :=
h.div_int $ by rwa int.coe_nat_ne_zero

theorem of_one_div (h : irrational (1 / x)) : irrational x :=
of_rat_div 1 $ by rwa [cast_one]

/-!
#### Natural and integerl power
-/

theorem of_mul_self (h : irrational (x * x)) : irrational x :=
h.mul_cases.elim id id

theorem of_pow : ∀ n : ℕ, irrational (x^n) → irrational x
| 0 := λ h, by { rw pow_zero at h, exact (h ⟨1, cast_one⟩).elim }
| (n+1) := λ h, by { rw pow_succ at h, exact h.mul_cases.elim id (of_pow n) }

theorem of_zpow : ∀ m : ℤ, irrational (x^m) → irrational x
| (n:ℕ) := of_pow n
| -[1+n] := λ h, by { rw zpow_neg_succ_of_nat at h, exact h.of_inv.of_pow _ }

end irrational

section polynomial

open polynomial
variables (x : ℝ) (p : polynomial ℤ)

lemma one_lt_nat_degree_of_irrational_root (hx : irrational x) (p_nonzero : p ≠ 0)
  (x_is_root : aeval x p = 0) : 1 < p.nat_degree :=
begin
  by_contra rid,
  rcases exists_eq_X_add_C_of_nat_degree_le_one (not_lt.1 rid) with ⟨a, b, rfl⟩, clear rid,
  have : (a : ℝ) * x = -b, by simpa [eq_neg_iff_add_eq_zero] using x_is_root,
  rcases em (a = 0) with (rfl|ha),
  { obtain rfl : b = 0, by simpa,
    simpa using p_nonzero },
  { rw [mul_comm, ← eq_div_iff_mul_eq, eq_comm] at this,
    refine hx ⟨-b / a, _⟩,
    assumption_mod_cast, assumption_mod_cast }
end

end polynomial

section
variables {q : ℚ} {m : ℤ} {n : ℕ} {x : ℝ}

open irrational

/-!
### Simplification lemmas about operations
-/

@[simp] theorem irrational_rat_add_iff : irrational (q + x) ↔ irrational x :=
⟨of_rat_add q, rat_add q⟩

@[simp] theorem irrational_int_add_iff : irrational (m + x) ↔ irrational x :=
⟨of_int_add m, λ h, h.int_add m⟩

@[simp] theorem irrational_nat_add_iff : irrational (n + x) ↔ irrational x :=
⟨of_nat_add n, λ h, h.nat_add n⟩

@[simp] theorem irrational_add_rat_iff : irrational (x + q) ↔ irrational x :=
⟨of_add_rat q, add_rat q⟩

@[simp] theorem irrational_add_int_iff : irrational (x + m) ↔ irrational x :=
⟨of_add_int m, λ h, h.add_int m⟩

@[simp] theorem irrational_add_nat_iff : irrational (x + n) ↔ irrational x :=
⟨of_add_nat n, λ h, h.add_nat n⟩

@[simp] theorem irrational_rat_sub_iff : irrational (q - x) ↔ irrational x :=
⟨of_rat_sub q, rat_sub q⟩

@[simp] theorem irrational_int_sub_iff : irrational (m - x) ↔ irrational x :=
⟨of_int_sub m, λ h, h.int_sub m⟩

@[simp] theorem irrational_nat_sub_iff : irrational (n - x) ↔ irrational x :=
⟨of_nat_sub n, λ h, h.nat_sub n⟩

@[simp] theorem irrational_sub_rat_iff : irrational (x - q) ↔ irrational x :=
⟨of_sub_rat q, sub_rat q⟩

@[simp] theorem irrational_sub_int_iff : irrational (x - m) ↔ irrational x :=
⟨of_sub_int m, λ h, h.sub_int m⟩

@[simp] theorem irrational_sub_nat_iff : irrational (x - n) ↔ irrational x :=
⟨of_sub_nat n, λ h, h.sub_nat n⟩

@[simp] theorem irrational_neg_iff : irrational (-x) ↔ irrational x :=
⟨of_neg, irrational.neg⟩

@[simp] theorem irrational_inv_iff : irrational x⁻¹ ↔ irrational x :=
⟨of_inv, irrational.inv⟩

@[simp] theorem irrational_rat_mul_iff : irrational (q * x) ↔ q ≠ 0 ∧ irrational x :=
⟨λ h, ⟨rat.cast_ne_zero.1 $ left_ne_zero_of_mul h.ne_zero, h.of_rat_mul q⟩, λ h, h.2.rat_mul h.1⟩

@[simp] theorem irrational_mul_rat_iff : irrational (x * q) ↔ q ≠ 0 ∧ irrational x :=
by rw [mul_comm, irrational_rat_mul_iff]

@[simp] theorem irrational_int_mul_iff : irrational (m * x) ↔ m ≠ 0 ∧ irrational x :=
by rw [← cast_coe_int, irrational_rat_mul_iff, int.cast_ne_zero]

@[simp] theorem irrational_mul_int_iff : irrational (x * m) ↔ m ≠ 0 ∧ irrational x :=
by rw [← cast_coe_int, irrational_mul_rat_iff, int.cast_ne_zero]

@[simp] theorem irrational_nat_mul_iff : irrational (n * x) ↔ n ≠ 0 ∧ irrational x :=
by rw [← cast_coe_nat, irrational_rat_mul_iff, nat.cast_ne_zero]

@[simp] theorem irrational_mul_nat_iff : irrational (x * n) ↔ n ≠ 0 ∧ irrational x :=
by rw [← cast_coe_nat, irrational_mul_rat_iff, nat.cast_ne_zero]

@[simp] theorem irrational_rat_div_iff : irrational (q / x) ↔ q ≠ 0 ∧ irrational x :=
by simp [div_eq_mul_inv]

@[simp] theorem irrational_div_rat_iff : irrational (x / q) ↔ q ≠ 0 ∧ irrational x :=
by rw [div_eq_mul_inv, ← cast_inv, irrational_mul_rat_iff, ne.def, inv_eq_zero]

@[simp] theorem irrational_int_div_iff : irrational (m / x) ↔ m ≠ 0 ∧ irrational x :=
by simp [div_eq_mul_inv]

@[simp] theorem irrational_div_int_iff : irrational (x / m) ↔ m ≠ 0 ∧ irrational x :=
by rw [← cast_coe_int, irrational_div_rat_iff, int.cast_ne_zero]

@[simp] theorem irrational_nat_div_iff : irrational (n / x) ↔ n ≠ 0 ∧ irrational x :=
by simp [div_eq_mul_inv]

@[simp] theorem irrational_div_nat_iff : irrational (x / n) ↔ n ≠ 0 ∧ irrational x :=
by rw [← cast_coe_nat, irrational_div_rat_iff, nat.cast_ne_zero]

/-- There is an irrational number `r` between any two reals `x < r < y`. -/
theorem exists_irrational_btwn {x y : ℝ} (h : x < y) :
  ∃ r, irrational r ∧ x < r ∧ r < y :=
let ⟨q, ⟨hq1, hq2⟩⟩ := (exists_rat_btwn ((sub_lt_sub_iff_right (real.sqrt 2)).mpr h)) in
  ⟨q + real.sqrt 2, irrational_sqrt_two.rat_add _,
    sub_lt_iff_lt_add.mp hq1, lt_sub_iff_add_lt.mp hq2⟩

end


variable (p q r : Prop)

#check Eq.refl

variable (α β : Type)

example (f : α → β) (a : α) : (fun x => f x) a = f a := Eq.refl (f a)

example (a : α) (b : α) : (a, b).1 = a := Eq.refl a

example : 2 + 3 = 5 := Eq.refl 5

def meets₁ (x : Nat) :=
  x ≥ 3

#eval meets₁ 4

#reduce meets₁ 4

example : meets₁ 3 :=
  calc
    meets₁ 3 = 3 ≥ 3 := by rw

def is_even (a : Nat) := ∃ b, a = 2 * b

#eval is_even 2

#reduce is_even 2

example : is_even 2 :=
  Exists.intro 1
    (
      calc
        is_even 2 = 2 * 1 := by rw [is_even]
    )

  example : 2 + 1 = 3 := rfl


import Mathlib.data.nat.prime

open Mathlib Mathlib.nat

theorem exists_infinite_primes (n : Nat) : ∃ p, n ≤ p ∧ prime p :=
  let p := min_fac (factorial n + 1)
  have f1 : factorial n + 1 ≠ 1 := ne_of_gt $ succ_lt_succ $ factorial_pos _
  have pp : prime p := min_fac_prime f1
  have np : n ≤ p := le_of_not_ge λ h =>
    have h₁ : p ∣ factorial n := dvd_factorial (min_fac_pos _) h
    have h₂ : p ∣ 1 := (nat.dvd_add_iff_right h₁).2 (min_fac_dvd _)
    pp.not_dvd_one h₂
  Exists.intro p ⟨np, pp⟩


namespace hidden

open nat

def pred (n : nat) : nat :=
nat.rec_on n
	(zero)
	(λ n pred_n : nat, n)

#reduce pred (succ zero)

example (n : nat) : pred (succ n) = n :=
nat.rec_on n
	(show pred (succ zero) = zero, from rfl)
	(assume n,
		assume ih,
		show pred (succ (succ n)) = succ n, from rfl)

def trun_sub (n m : nat) : nat :=
nat.rec_on m n (λ m nmm : nat, pred nmm)

end hidden

namespace hidden
-- BEGIN
open nat
inductive list (α : Type*)
| nil {} : list
| cons : α → list → list

namespace list

variable {α : Type*}

notation h :: t  := cons h t
notation `[` l:(foldr `,` (h t, cons h t) nil) `]` := l

def append (s t : list α) : list α :=
list.rec t (λ x l u, x::u) s

notation s ++ t := append s t

theorem nil_append (t : list α) : nil ++ t = t := rfl

theorem cons_append (x : α) (s t : list α) :
  x::s ++ t = x::(s ++ t) := rfl

theorem append_nil (t : list α) : t ++ nil = t :=
list.rec_on t (rfl)
(begin
	intros,
	rw cons_append,
	rw ih
end)

def length (s : list α) : ℕ :=
list.rec 0 (λ a spa u, u+1) s

#reduce length [1,2,3,4]

theorem length_append (s t : list α) : length (s ++ t) = length s + length t :=
list.rec_on s
(calc
 length (nil ++ t) = length t : by rw nil_append
 ... = 0 + length t : by rw nat.zero_add
 ... = length nil + length t : rfl)
(assume a, assume a_1, assume ih,
	calc
	(a :: a_1 ++ t).length = (a :: (a_1 ++ t)).length : by rw cons_append
	... = (a_1 ++ t).length +1 : rfl
	... = a_1.length + t.length + 1 : by rw ih
	... = (1+ a_1.length )+ t.length : by repeat {rw nat.add_comm, rw nat.add_assoc}
	... = (a_1.length+1) + t.length : by simp [nat.add_comm]
	... = (a::a_1).length + t.length : rfl
)

def reverse (s : list α) : list α :=
list.rec nil (λ a spa rev, rev++[a]) s

theorem nil_reverse : nil.reverse = @nil α := rfl

#reduce reverse [2,6,9,2,1,5]

example (t : list α ) : t.reverse.length = t.length :=
list.rec_on t (by rw nil_reverse)
(assume a, assume a_1, assume ih, calc
(a :: a_1).reverse.length = (a_1.reverse ++ [a]).length : rfl
... = a_1.reverse.length + [a].length : by rw length_append
... = a_1.length + 1 : by repeat {rw ih, apply rfl}
... = (a::a_1).length : rfl)

theorem rev_append (l s : list α) : (l++s).reverse = s.reverse++l.reverse :=
list.rec_on l
(calc
(nil ++ s).reverse = s.reverse : by rw nil_append
... = s.reverse ++ nil : by rw append_nil
... = s.reverse ++ nil.reverse : by rw nil_reverse)
(assume a, assume a_1, assume ih, calc
(a :: a_1 ++ s).reverse = (a :: (a_1 ++ s)).reverse : rfl
... = (a_1 ++ s).reverse ++ [a] : rfl
... = s.reverse ++ a_1.reverse ++ [a] : by rw ih
... = s.reverse ++ (a_1.reverse ++ [a]) : _
... = s.reverse ++ (a :: a_1).reverse : rfl)

example (t : list α) : t.reverse.reverse = t :=
list.rec_on t (rfl)
(assume a, assume a_1, assume ih, calc
(a :: a_1).reverse.reverse = ((a_1.reverse)++[a]).reverse : rfl
... = [a].reverse++a_1.reverse.reverse : by rw rev_append
... = [a]++a_1.reverse.reverse : rfl
... = [a]++a_1 : by rw ih
... = a :: a_1 : rfl)

end list
-- END
end hidden