/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot, Yury Kudryashov, Rémy Degenne
-/
import algebra.order.group
import order.rel_iso

/-!
# Intervals

In any preorder `α`, we define intervals (which on each side can be either infinite, open, or
closed) using the following naming conventions:
- `i`: infinite
- `o`: open
- `c`: closed

Each interval has the name `I` + letter for left side + letter for right side. For instance,
`Ioc a b` denotes the inverval `(a, b]`.

This file contains these definitions, and basic facts on inclusion, intersection, difference of
intervals (where the precise statements may depend on the properties of the order, in particular
for some statements it should be `linear_order` or `densely_ordered`).

TODO: This is just the beginning; a lot of rules are missing
-/

universe u

namespace set

open set
open order_dual (to_dual of_dual)

section preorder
variables {α : Type u} [preorder α] {a a₁ a₂ b b₁ b₂ c x : α}

/-- Left-open right-open interval -/
def Ioo (a b : α) := {x | a < x ∧ x < b}

/-- Left-closed right-open interval -/
def Ico (a b : α) := {x | a ≤ x ∧ x < b}

/-- Left-infinite right-open interval -/
def Iio (a : α) := {x | x < a}

/-- Left-closed right-closed interval -/
def Icc (a b : α) := {x | a ≤ x ∧ x ≤ b}

/-- Left-infinite right-closed interval -/
def Iic (b : α) := {x | x ≤ b}

/-- Left-open right-closed interval -/
def Ioc (a b : α) := {x | a < x ∧ x ≤ b}

/-- Left-closed right-infinite interval -/
def Ici (a : α) := {x | a ≤ x}

/-- Left-open right-infinite interval -/
def Ioi (a : α) := {x | a < x}

lemma Ioo_def (a b : α) : {x | a < x ∧ x < b} = Ioo a b := rfl

lemma Ico_def (a b : α) : {x | a ≤ x ∧ x < b} = Ico a b := rfl

lemma Iio_def (a : α) : {x | x < a} = Iio a := rfl

lemma Icc_def (a b : α) : {x | a ≤ x ∧ x ≤ b} = Icc a b := rfl

lemma Iic_def (b : α) : {x | x ≤ b} = Iic b := rfl

lemma Ioc_def (a b : α) : {x | a < x ∧ x ≤ b} = Ioc a b := rfl

lemma Ici_def (a : α) : {x | a ≤ x} = Ici a := rfl

lemma Ioi_def (a : α) : {x | a < x} = Ioi a := rfl

@[simp] lemma mem_Ioo : x ∈ Ioo a b ↔ a < x ∧ x < b := iff.rfl
@[simp] lemma mem_Ico : x ∈ Ico a b ↔ a ≤ x ∧ x < b := iff.rfl
@[simp] lemma mem_Iio : x ∈ Iio b ↔ x < b := iff.rfl
@[simp] lemma mem_Icc : x ∈ Icc a b ↔ a ≤ x ∧ x ≤ b := iff.rfl
@[simp] lemma mem_Iic : x ∈ Iic b ↔ x ≤ b := iff.rfl
@[simp] lemma mem_Ioc : x ∈ Ioc a b ↔ a < x ∧ x ≤ b := iff.rfl
@[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := iff.rfl
@[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := iff.rfl

@[simp] lemma left_mem_Ioo : a ∈ Ioo a b ↔ false := by simp [lt_irrefl]
@[simp] lemma left_mem_Ico : a ∈ Ico a b ↔ a < b := by simp [le_refl]
@[simp] lemma left_mem_Icc : a ∈ Icc a b ↔ a ≤ b := by simp [le_refl]
@[simp] lemma left_mem_Ioc : a ∈ Ioc a b ↔ false := by simp [lt_irrefl]
lemma left_mem_Ici : a ∈ Ici a := by simp
@[simp] lemma right_mem_Ioo : b ∈ Ioo a b ↔ false := by simp [lt_irrefl]
@[simp] lemma right_mem_Ico : b ∈ Ico a b ↔ false := by simp [lt_irrefl]
@[simp] lemma right_mem_Icc : b ∈ Icc a b ↔ a ≤ b := by simp [le_refl]
@[simp] lemma right_mem_Ioc : b ∈ Ioc a b ↔ a < b := by simp [le_refl]
lemma right_mem_Iic : a ∈ Iic a := by simp

@[simp] lemma dual_Ici : Ici (to_dual a) = of_dual ⁻¹' Iic a := rfl
@[simp] lemma dual_Iic : Iic (to_dual a) = of_dual ⁻¹' Ici a := rfl
@[simp] lemma dual_Ioi : Ioi (to_dual a) = of_dual ⁻¹' Iio a := rfl
@[simp] lemma dual_Iio : Iio (to_dual a) = of_dual ⁻¹' Ioi a := rfl
@[simp] lemma dual_Icc : Icc (to_dual a) (to_dual b) = of_dual ⁻¹' Icc b a :=
set.ext $ λ x, and_comm _ _
@[simp] lemma dual_Ioc : Ioc (to_dual a) (to_dual b) = of_dual ⁻¹' Ico b a :=
set.ext $ λ x, and_comm _ _
@[simp] lemma dual_Ico : Ico (to_dual a) (to_dual b) = of_dual ⁻¹' Ioc b a :=
set.ext $ λ x, and_comm _ _
@[simp] lemma dual_Ioo : Ioo (to_dual a) (to_dual b) = of_dual ⁻¹' Ioo b a :=
set.ext $ λ x, and_comm _ _

@[simp] lemma nonempty_Icc : (Icc a b).nonempty ↔ a ≤ b :=
⟨λ ⟨x, hx⟩, hx.1.trans hx.2, λ h, ⟨a, left_mem_Icc.2 h⟩⟩

@[simp] lemma nonempty_Ico : (Ico a b).nonempty ↔ a < b :=
⟨λ ⟨x, hx⟩, hx.1.trans_lt hx.2, λ h, ⟨a, left_mem_Ico.2 h⟩⟩

@[simp] lemma nonempty_Ioc : (Ioc a b).nonempty ↔ a < b :=
⟨λ ⟨x, hx⟩, hx.1.trans_le hx.2, λ h, ⟨b, right_mem_Ioc.2 h⟩⟩

@[simp] lemma nonempty_Ici : (Ici a).nonempty := ⟨a, left_mem_Ici⟩

@[simp] lemma nonempty_Iic : (Iic a).nonempty := ⟨a, right_mem_Iic⟩

@[simp] lemma nonempty_Ioo [densely_ordered α] : (Ioo a b).nonempty ↔ a < b :=
⟨λ ⟨x, ha, hb⟩, ha.trans hb, exists_between⟩

@[simp] lemma nonempty_Ioi [no_max_order α] : (Ioi a).nonempty := exists_gt a
@[simp] lemma nonempty_Iio [no_min_order α] : (Iio a).nonempty := exists_lt a

lemma nonempty_Icc_subtype (h : a ≤ b) : nonempty (Icc a b) :=
nonempty.to_subtype (nonempty_Icc.mpr h)

lemma nonempty_Ico_subtype (h : a < b) : nonempty (Ico a b) :=
nonempty.to_subtype (nonempty_Ico.mpr h)

lemma nonempty_Ioc_subtype (h : a < b) : nonempty (Ioc a b) :=
nonempty.to_subtype (nonempty_Ioc.mpr h)

/-- An interval `Ici a` is nonempty. -/
instance nonempty_Ici_subtype : nonempty (Ici a) :=
nonempty.to_subtype nonempty_Ici

/-- An interval `Iic a` is nonempty. -/
instance nonempty_Iic_subtype : nonempty (Iic a) :=
nonempty.to_subtype nonempty_Iic

lemma nonempty_Ioo_subtype [densely_ordered α] (h : a < b) : nonempty (Ioo a b) :=
nonempty.to_subtype (nonempty_Ioo.mpr h)

/-- In an order without maximal elements, the intervals `Ioi` are nonempty. -/
instance nonempty_Ioi_subtype [no_max_order α] : nonempty (Ioi a) :=
nonempty.to_subtype nonempty_Ioi

/-- In an order without minimal elements, the intervals `Iio` are nonempty. -/
instance nonempty_Iio_subtype [no_min_order α] : nonempty (Iio a) :=
nonempty.to_subtype nonempty_Iio

@[simp] lemma Icc_eq_empty (h : ¬a ≤ b) : Icc a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨ha, hb⟩, h (ha.trans hb)

@[simp] lemma Ico_eq_empty (h : ¬a < b) : Ico a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨ha, hb⟩, h (ha.trans_lt hb)

@[simp] lemma Ioc_eq_empty (h : ¬a < b) : Ioc a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨ha, hb⟩, h (ha.trans_le hb)

@[simp] lemma Ioo_eq_empty (h : ¬a < b) : Ioo a b = ∅ :=
eq_empty_iff_forall_not_mem.2 $ λ x ⟨ha, hb⟩,  h (ha.trans hb)

@[simp] lemma Icc_eq_empty_of_lt (h : b < a) : Icc a b = ∅ :=
Icc_eq_empty h.not_le

@[simp] lemma Ico_eq_empty_of_le (h : b ≤ a) : Ico a b = ∅ :=
Ico_eq_empty h.not_lt

@[simp] lemma Ioc_eq_empty_of_le (h : b ≤ a) : Ioc a b = ∅ :=
Ioc_eq_empty h.not_lt

@[simp] lemma Ioo_eq_empty_of_le (h : b ≤ a) : Ioo a b = ∅ :=
Ioo_eq_empty h.not_lt

@[simp] lemma Ico_self (a : α) : Ico a a = ∅ := Ico_eq_empty $ lt_irrefl _
@[simp] lemma Ioc_self (a : α) : Ioc a a = ∅ := Ioc_eq_empty $ lt_irrefl _
@[simp] lemma Ioo_self (a : α) : Ioo a a = ∅ := Ioo_eq_empty $ lt_irrefl _

lemma Ici_subset_Ici : Ici a ⊆ Ici b ↔ b ≤ a :=
⟨λ h, h $ left_mem_Ici, λ h x hx, h.trans hx⟩

lemma Iic_subset_Iic : Iic a ⊆ Iic b ↔ a ≤ b :=
@Ici_subset_Ici (order_dual α) _ _ _

lemma Ici_subset_Ioi : Ici a ⊆ Ioi b ↔ b < a :=
⟨λ h, h left_mem_Ici, λ h x hx, h.trans_le hx⟩

lemma Iic_subset_Iio : Iic a ⊆ Iio b ↔ a < b :=
⟨λ h, h right_mem_Iic, λ h x hx, lt_of_le_of_lt hx h⟩

lemma Ioo_subset_Ioo (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Ioo a₁ b₁ ⊆ Ioo a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨h₁.trans_lt hx₁, hx₂.trans_le h₂⟩

lemma Ioo_subset_Ioo_left (h : a₁ ≤ a₂) : Ioo a₂ b ⊆ Ioo a₁ b :=
Ioo_subset_Ioo h le_rfl

lemma Ioo_subset_Ioo_right (h : b₁ ≤ b₂) : Ioo a b₁ ⊆ Ioo a b₂ :=
Ioo_subset_Ioo le_rfl h

lemma Ico_subset_Ico (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Ico a₁ b₁ ⊆ Ico a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨h₁.trans hx₁, hx₂.trans_le h₂⟩

lemma Ico_subset_Ico_left (h : a₁ ≤ a₂) : Ico a₂ b ⊆ Ico a₁ b :=
Ico_subset_Ico h le_rfl

lemma Ico_subset_Ico_right (h : b₁ ≤ b₂) : Ico a b₁ ⊆ Ico a b₂ :=
Ico_subset_Ico le_rfl h

lemma Icc_subset_Icc (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Icc a₁ b₁ ⊆ Icc a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨h₁.trans hx₁, le_trans hx₂ h₂⟩

lemma Icc_subset_Icc_left (h : a₁ ≤ a₂) : Icc a₂ b ⊆ Icc a₁ b :=
Icc_subset_Icc h le_rfl

lemma Icc_subset_Icc_right (h : b₁ ≤ b₂) : Icc a b₁ ⊆ Icc a b₂ :=
Icc_subset_Icc le_rfl h

lemma Icc_subset_Ioo (ha : a₂ < a₁) (hb : b₁ < b₂) :
  Icc a₁ b₁ ⊆ Ioo a₂ b₂ :=
λ x hx, ⟨ha.trans_le hx.1, hx.2.trans_lt hb⟩

lemma Icc_subset_Ici_self : Icc a b ⊆ Ici a := λ x, and.left

lemma Icc_subset_Iic_self : Icc a b ⊆ Iic b := λ x, and.right

lemma Ioc_subset_Iic_self : Ioc a b ⊆ Iic b := λ x, and.right

lemma Ioc_subset_Ioc (h₁ : a₂ ≤ a₁) (h₂ : b₁ ≤ b₂) :
  Ioc a₁ b₁ ⊆ Ioc a₂ b₂ :=
λ x ⟨hx₁, hx₂⟩, ⟨h₁.trans_lt hx₁, hx₂.trans h₂⟩

lemma Ioc_subset_Ioc_left (h : a₁ ≤ a₂) : Ioc a₂ b ⊆ Ioc a₁ b :=
Ioc_subset_Ioc h le_rfl

lemma Ioc_subset_Ioc_right (h : b₁ ≤ b₂) : Ioc a b₁ ⊆ Ioc a b₂ :=
Ioc_subset_Ioc le_rfl h

lemma Ico_subset_Ioo_left (h₁ : a₁ < a₂) : Ico a₂ b ⊆ Ioo a₁ b :=
λ x, and.imp_left h₁.trans_le

lemma Ioc_subset_Ioo_right (h : b₁ < b₂) : Ioc a b₁ ⊆ Ioo a b₂ :=
λ x, and.imp_right $ λ h', h'.trans_lt h

lemma Icc_subset_Ico_right (h₁ : b₁ < b₂) : Icc a b₁ ⊆ Ico a b₂ :=
λ x, and.imp_right $ λ h₂, h₂.trans_lt h₁

lemma Ioo_subset_Ico_self : Ioo a b ⊆ Ico a b := λ x, and.imp_left le_of_lt

lemma Ioo_subset_Ioc_self : Ioo a b ⊆ Ioc a b := λ x, and.imp_right le_of_lt

lemma Ico_subset_Icc_self : Ico a b ⊆ Icc a b := λ x, and.imp_right le_of_lt

lemma Ioc_subset_Icc_self : Ioc a b ⊆ Icc a b := λ x, and.imp_left le_of_lt

lemma Ioo_subset_Icc_self : Ioo a b ⊆ Icc a b :=
subset.trans Ioo_subset_Ico_self Ico_subset_Icc_self

lemma Ico_subset_Iio_self : Ico a b ⊆ Iio b := λ x, and.right

lemma Ioo_subset_Iio_self : Ioo a b ⊆ Iio b := λ x, and.right

lemma Ioc_subset_Ioi_self : Ioc a b ⊆ Ioi a := λ x, and.left

lemma Ioo_subset_Ioi_self : Ioo a b ⊆ Ioi a := λ x, and.left

lemma Ioi_subset_Ici_self : Ioi a ⊆ Ici a := λ x hx, le_of_lt hx

lemma Iio_subset_Iic_self : Iio a ⊆ Iic a := λ x hx, le_of_lt hx

lemma Ico_subset_Ici_self : Ico a b ⊆ Ici a := λ x, and.left

lemma Icc_subset_Icc_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Icc a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, ⟨(h ⟨le_rfl, h₁⟩).1, (h ⟨h₁, le_rfl⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨h.trans hx, hx'.trans h'⟩⟩

lemma Icc_subset_Ioo_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ioo a₂ b₂ ↔ a₂ < a₁ ∧ b₁ < b₂ :=
⟨λ h, ⟨(h ⟨le_rfl, h₁⟩).1, (h ⟨h₁, le_rfl⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨h.trans_le hx, hx'.trans_lt h'⟩⟩

lemma Icc_subset_Ico_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ < b₂ :=
⟨λ h, ⟨(h ⟨le_rfl, h₁⟩).1, (h ⟨h₁, le_rfl⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨h.trans hx, hx'.trans_lt h'⟩⟩

lemma Icc_subset_Ioc_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ioc a₂ b₂ ↔ a₂ < a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, ⟨(h ⟨le_rfl, h₁⟩).1, (h ⟨h₁, le_rfl⟩).2⟩,
 λ ⟨h, h'⟩ x ⟨hx, hx'⟩, ⟨h.trans_le hx, hx'.trans h'⟩⟩

lemma Icc_subset_Iio_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Iio b₂ ↔ b₁ < b₂ :=
⟨λ h, h ⟨h₁, le_rfl⟩, λ h x ⟨hx, hx'⟩, hx'.trans_lt h⟩

lemma Icc_subset_Ioi_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ioi a₂ ↔ a₂ < a₁ :=
⟨λ h, h ⟨le_rfl, h₁⟩, λ h x ⟨hx, hx'⟩, h.trans_le hx⟩

lemma Icc_subset_Iic_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Iic b₂ ↔ b₁ ≤ b₂ :=
⟨λ h, h ⟨h₁, le_rfl⟩, λ h x ⟨hx, hx'⟩, hx'.trans h⟩

lemma Icc_subset_Ici_iff (h₁ : a₁ ≤ b₁) :
  Icc a₁ b₁ ⊆ Ici a₂ ↔ a₂ ≤ a₁ :=
⟨λ h, h ⟨le_rfl, h₁⟩, λ h x ⟨hx, hx'⟩, h.trans hx⟩

lemma Icc_ssubset_Icc_left (hI : a₂ ≤ b₂) (ha : a₂ < a₁) (hb : b₁ ≤ b₂) :
  Icc a₁ b₁ ⊂ Icc a₂ b₂ :=
(ssubset_iff_of_subset (Icc_subset_Icc (le_of_lt ha) hb)).mpr
  ⟨a₂, left_mem_Icc.mpr hI, not_and.mpr (λ f g, lt_irrefl a₂ (ha.trans_le f))⟩

lemma Icc_ssubset_Icc_right (hI : a₂ ≤ b₂) (ha : a₂ ≤ a₁) (hb : b₁ < b₂) :
  Icc a₁ b₁ ⊂ Icc a₂ b₂ :=
(ssubset_iff_of_subset (Icc_subset_Icc ha (le_of_lt hb))).mpr
  ⟨b₂, right_mem_Icc.mpr hI, (λ f, lt_irrefl b₁ (hb.trans_le f.2))⟩

/-- If `a ≤ b`, then `(b, +∞) ⊆ (a, +∞)`. In preorders, this is just an implication. If you need
the equivalence in linear orders, use `Ioi_subset_Ioi_iff`. -/
lemma Ioi_subset_Ioi (h : a ≤ b) : Ioi b ⊆ Ioi a :=
λ x hx, h.trans_lt hx

/-- If `a ≤ b`, then `(b, +∞) ⊆ [a, +∞)`. In preorders, this is just an implication. If you need
the equivalence in dense linear orders, use `Ioi_subset_Ici_iff`. -/
lemma Ioi_subset_Ici (h : a ≤ b) : Ioi b ⊆ Ici a :=
subset.trans (Ioi_subset_Ioi h) Ioi_subset_Ici_self

/-- If `a ≤ b`, then `(-∞, a) ⊆ (-∞, b)`. In preorders, this is just an implication. If you need
the equivalence in linear orders, use `Iio_subset_Iio_iff`. -/
lemma Iio_subset_Iio (h : a ≤ b) : Iio a ⊆ Iio b :=
λ x hx, lt_of_lt_of_le hx h

/-- If `a ≤ b`, then `(-∞, a) ⊆ (-∞, b]`. In preorders, this is just an implication. If you need
the equivalence in dense linear orders, use `Iio_subset_Iic_iff`. -/
lemma Iio_subset_Iic (h : a ≤ b) : Iio a ⊆ Iic b :=
subset.trans (Iio_subset_Iio h) Iio_subset_Iic_self

lemma Ici_inter_Iic : Ici a ∩ Iic b = Icc a b := rfl
lemma Ici_inter_Iio : Ici a ∩ Iio b = Ico a b := rfl
lemma Ioi_inter_Iic : Ioi a ∩ Iic b = Ioc a b := rfl
lemma Ioi_inter_Iio : Ioi a ∩ Iio b = Ioo a b := rfl

lemma mem_Icc_of_Ioo (h : x ∈ Ioo a b) : x ∈ Icc a b := Ioo_subset_Icc_self h
lemma mem_Ico_of_Ioo (h : x ∈ Ioo a b) : x ∈ Ico a b := Ioo_subset_Ico_self h
lemma mem_Ioc_of_Ioo (h : x ∈ Ioo a b) : x ∈ Ioc a b := Ioo_subset_Ioc_self h
lemma mem_Icc_of_Ico (h : x ∈ Ico a b) : x ∈ Icc a b := Ico_subset_Icc_self h
lemma mem_Icc_of_Ioc (h : x ∈ Ioc a b) : x ∈ Icc a b := Ioc_subset_Icc_self h
lemma mem_Ici_of_Ioi (h : x ∈ Ioi a) : x ∈ Ici a := Ioi_subset_Ici_self h
lemma mem_Iic_of_Iio (h : x ∈ Iio a) : x ∈ Iic a := Iio_subset_Iic_self h

lemma Icc_eq_empty_iff : Icc a b = ∅ ↔ ¬a ≤ b :=
by rw [←not_nonempty_iff_eq_empty, not_iff_not, nonempty_Icc]

lemma Ico_eq_empty_iff : Ico a b = ∅ ↔ ¬a < b :=
by rw [←not_nonempty_iff_eq_empty, not_iff_not, nonempty_Ico]

lemma Ioc_eq_empty_iff : Ioc a b = ∅ ↔ ¬a < b :=
by rw [←not_nonempty_iff_eq_empty, not_iff_not, nonempty_Ioc]

lemma Ioo_eq_empty_iff [densely_ordered α] : Ioo a b = ∅ ↔ ¬a < b :=
by rw [←not_nonempty_iff_eq_empty, not_iff_not, nonempty_Ioo]

lemma _root_.is_top.Iic_eq (h : is_top a) : Iic a = univ := eq_univ_of_forall h
lemma _root_.is_bot.Ici_eq (h : is_bot a) : Ici a = univ := eq_univ_of_forall h
lemma _root_.is_max.Ioi_eq (h : is_max a) : Ioi a = ∅ := eq_empty_of_subset_empty $ λ b, h.not_lt
lemma _root_.is_min.Iio_eq (h : is_min a) : Iio a = ∅ := eq_empty_of_subset_empty $ λ b, h.not_lt

lemma Iic_inter_Ioc_of_le (h : a ≤ c) : Iic a ∩ Ioc b c = Ioc b a :=
ext $ λ x, ⟨λ H, ⟨H.2.1, H.1⟩, λ H, ⟨H.2, H.1, H.2.trans h⟩⟩

end preorder

section partial_order
variables {α : Type u} [partial_order α] {a b c : α}

@[simp] lemma Icc_self (a : α) : Icc a a = {a} :=
set.ext $ by simp [Icc, le_antisymm_iff, and_comm]

@[simp] lemma Icc_eq_singleton_iff : Icc a b = {c} ↔ a = c ∧ b = c :=
begin
  refine ⟨λ h, _, _⟩,
  { have hab : a ≤ b := nonempty_Icc.1 (h.symm.subst $ singleton_nonempty c),
    exact ⟨eq_of_mem_singleton $ h.subst $ left_mem_Icc.2 hab,
      eq_of_mem_singleton $ h.subst $ right_mem_Icc.2 hab⟩ },
  { rintro ⟨rfl, rfl⟩,
    exact Icc_self _ }
end

@[simp] lemma Icc_diff_left : Icc a b \ {a} = Ioc a b :=
ext $ λ x, by simp [lt_iff_le_and_ne, eq_comm, and.right_comm]

@[simp] lemma Icc_diff_right : Icc a b \ {b} = Ico a b :=
ext $ λ x, by simp [lt_iff_le_and_ne, and_assoc]

@[simp] lemma Ico_diff_left : Ico a b \ {a} = Ioo a b :=
ext $ λ x, by simp [and.right_comm, ← lt_iff_le_and_ne, eq_comm]

@[simp] lemma Ioc_diff_right : Ioc a b \ {b} = Ioo a b :=
ext $ λ x, by simp [and_assoc, ← lt_iff_le_and_ne]

@[simp] lemma Icc_diff_both : Icc a b \ {a, b} = Ioo a b :=
by rw [insert_eq, ← diff_diff, Icc_diff_left, Ioc_diff_right]

@[simp] lemma Ici_diff_left : Ici a \ {a} = Ioi a :=
ext $ λ x, by simp [lt_iff_le_and_ne, eq_comm]

@[simp] lemma Iic_diff_right : Iic a \ {a} = Iio a :=
ext $ λ x, by simp [lt_iff_le_and_ne]

@[simp] lemma Ico_diff_Ioo_same (h : a < b) : Ico a b \ Ioo a b = {a} :=
by rw [← Ico_diff_left, diff_diff_cancel_left (singleton_subset_iff.2 $ left_mem_Ico.2 h)]

@[simp] lemma Ioc_diff_Ioo_same (h : a < b) : Ioc a b \ Ioo a b = {b} :=
by rw [← Ioc_diff_right, diff_diff_cancel_left (singleton_subset_iff.2 $ right_mem_Ioc.2 h)]

@[simp] lemma Icc_diff_Ico_same (h : a ≤ b) : Icc a b \ Ico a b = {b} :=
by rw [← Icc_diff_right, diff_diff_cancel_left (singleton_subset_iff.2 $ right_mem_Icc.2 h)]

@[simp] lemma Icc_diff_Ioc_same (h : a ≤ b) : Icc a b \ Ioc a b = {a} :=
by rw [← Icc_diff_left, diff_diff_cancel_left (singleton_subset_iff.2 $ left_mem_Icc.2 h)]

@[simp] lemma Icc_diff_Ioo_same (h : a ≤ b) : Icc a b \ Ioo a b = {a, b} :=
by { rw [← Icc_diff_both, diff_diff_cancel_left], simp [insert_subset, h] }

@[simp] lemma Ici_diff_Ioi_same : Ici a \ Ioi a = {a} :=
by rw [← Ici_diff_left, diff_diff_cancel_left (singleton_subset_iff.2 left_mem_Ici)]

@[simp] lemma Iic_diff_Iio_same : Iic a \ Iio a = {a} :=
by rw [← Iic_diff_right, diff_diff_cancel_left (singleton_subset_iff.2 right_mem_Iic)]

@[simp] lemma Ioi_union_left : Ioi a ∪ {a} = Ici a := ext $ λ x, by simp [eq_comm, le_iff_eq_or_lt]

@[simp] lemma Iio_union_right : Iio a ∪ {a} = Iic a := ext $ λ x, le_iff_lt_or_eq.symm

lemma Ioo_union_left (hab : a < b) : Ioo a b ∪ {a} = Ico a b :=
by rw [← Ico_diff_left, diff_union_self,
  union_eq_self_of_subset_right (singleton_subset_iff.2 $ left_mem_Ico.2 hab)]

lemma Ioo_union_right (hab : a < b) : Ioo a b ∪ {b} = Ioc a b :=
by simpa only [dual_Ioo, dual_Ico] using Ioo_union_left hab.dual

lemma Ioc_union_left (hab : a ≤ b) : Ioc a b ∪ {a} = Icc a b :=
by rw [← Icc_diff_left, diff_union_self,
  union_eq_self_of_subset_right (singleton_subset_iff.2 $ left_mem_Icc.2 hab)]

lemma Ico_union_right (hab : a ≤ b) : Ico a b ∪ {b} = Icc a b :=
by simpa only [dual_Ioc, dual_Icc] using Ioc_union_left hab.dual

lemma mem_Ici_Ioi_of_subset_of_subset {s : set α} (ho : Ioi a ⊆ s) (hc : s ⊆ Ici a) :
  s ∈ ({Ici a, Ioi a} : set (set α)) :=
classical.by_cases
  (λ h : a ∈ s, or.inl $ subset.antisymm hc $ by rw [← Ioi_union_left, union_subset_iff]; simp *)
  (λ h, or.inr $ subset.antisymm (λ x hx, lt_of_le_of_ne (hc hx) (λ heq, h $ heq.symm ▸ hx)) ho)

lemma mem_Iic_Iio_of_subset_of_subset {s : set α} (ho : Iio a ⊆ s) (hc : s ⊆ Iic a) :
  s ∈ ({Iic a, Iio a} : set (set α)) :=
@mem_Ici_Ioi_of_subset_of_subset (order_dual α) _ a s ho hc

lemma mem_Icc_Ico_Ioc_Ioo_of_subset_of_subset {s : set α} (ho : Ioo a b ⊆ s) (hc : s ⊆ Icc a b) :
  s ∈ ({Icc a b, Ico a b, Ioc a b, Ioo a b} : set (set α)) :=
begin
  classical,
  by_cases ha : a ∈ s; by_cases hb : b ∈ s,
  { refine or.inl (subset.antisymm hc _),
    rwa [← Ico_diff_left, diff_singleton_subset_iff, insert_eq_of_mem ha,
      ← Icc_diff_right, diff_singleton_subset_iff, insert_eq_of_mem hb] at ho },
  { refine (or.inr $ or.inl $ subset.antisymm _ _),
    { rw [← Icc_diff_right],
      exact subset_diff_singleton hc hb },
    { rwa [← Ico_diff_left, diff_singleton_subset_iff, insert_eq_of_mem ha] at ho } },
  { refine (or.inr $ or.inr $ or.inl $ subset.antisymm _ _),
    { rw [← Icc_diff_left],
      exact subset_diff_singleton hc ha },
    { rwa [← Ioc_diff_right, diff_singleton_subset_iff, insert_eq_of_mem hb] at ho } },
  { refine (or.inr $ or.inr $ or.inr $ subset.antisymm _ ho),
    rw [← Ico_diff_left, ← Icc_diff_right],
    apply_rules [subset_diff_singleton] }
end

lemma eq_left_or_mem_Ioo_of_mem_Ico {x : α} (hmem : x ∈ Ico a b) :
  x = a ∨ x ∈ Ioo a b :=
hmem.1.eq_or_gt.imp_right $ λ h, ⟨h, hmem.2⟩

lemma eq_right_or_mem_Ioo_of_mem_Ioc {x : α} (hmem : x ∈ Ioc a b) :
  x = b ∨ x ∈ Ioo a b :=
hmem.2.eq_or_lt.imp_right $ and.intro hmem.1

lemma eq_endpoints_or_mem_Ioo_of_mem_Icc {x : α} (hmem : x ∈ Icc a b) :
  x = a ∨ x = b ∨ x ∈ Ioo a b :=
hmem.1.eq_or_gt.imp_right $ λ h, eq_right_or_mem_Ioo_of_mem_Ioc ⟨h, hmem.2⟩

lemma _root_.is_max.Ici_eq (h : is_max a) : Ici a = {a} :=
eq_singleton_iff_unique_mem.2 ⟨left_mem_Ici, λ b, h.eq_of_ge⟩

lemma _root_.is_min.Iic_eq (h : is_min a) : Iic a = {a} := h.to_dual.Ici_eq

end partial_order

section order_top

@[simp] lemma Ici_top {α : Type u} [partial_order α] [order_top α] : Ici (⊤ : α) = {⊤} :=
is_max_top.Ici_eq

variables {α : Type u} [preorder α] [order_top α] {a : α}

@[simp] lemma Ioi_top : Ioi (⊤ : α) = ∅ := is_max_top.Ioi_eq
@[simp] lemma Iic_top : Iic (⊤ : α) = univ := is_top_top.Iic_eq
@[simp] lemma Icc_top : Icc a ⊤ = Ici a := by simp [← Ici_inter_Iic]
@[simp] lemma Ioc_top : Ioc a ⊤ = Ioi a := by simp [← Ioi_inter_Iic]

end order_top

section order_bot

@[simp] lemma Iic_bot {α : Type u} [partial_order α] [order_bot α] : Iic (⊥ : α) = {⊥} :=
is_min_bot.Iic_eq

variables {α : Type u} [preorder α] [order_bot α] {a : α}

@[simp] lemma Iio_bot : Iio (⊥ : α) = ∅ := is_min_bot.Iio_eq
@[simp] lemma Ici_bot : Ici (⊥ : α) = univ := is_bot_bot.Ici_eq
@[simp] lemma Icc_bot : Icc ⊥ a = Iic a := by simp [← Ici_inter_Iic]
@[simp] lemma Ico_bot : Ico ⊥ a = Iio a := by simp [← Ici_inter_Iio]

end order_bot

section linear_order
variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ c d : α}

lemma not_mem_Ici : c ∉ Ici a ↔ c < a := not_le

lemma not_mem_Iic : c ∉ Iic b ↔ b < c := not_le

lemma not_mem_Icc_of_lt (ha : c < a) : c ∉ Icc a b :=
not_mem_subset Icc_subset_Ici_self $ not_mem_Ici.mpr ha

lemma not_mem_Icc_of_gt (hb : b < c) : c ∉ Icc a b :=
not_mem_subset Icc_subset_Iic_self $ not_mem_Iic.mpr hb

lemma not_mem_Ico_of_lt (ha : c < a) : c ∉ Ico a b :=
not_mem_subset Ico_subset_Ici_self $ not_mem_Ici.mpr ha

lemma not_mem_Ioc_of_gt (hb : b < c) : c ∉ Ioc a b :=
not_mem_subset Ioc_subset_Iic_self $ not_mem_Iic.mpr hb

lemma not_mem_Ioi : c ∉ Ioi a ↔ c ≤ a := not_lt

lemma not_mem_Iio : c ∉ Iio b ↔ b ≤ c := not_lt

lemma not_mem_Ioc_of_le (ha : c ≤ a) : c ∉ Ioc a b :=
not_mem_subset Ioc_subset_Ioi_self $ not_mem_Ioi.mpr ha

lemma not_mem_Ico_of_ge (hb : b ≤ c) : c ∉ Ico a b :=
not_mem_subset Ico_subset_Iio_self $ not_mem_Iio.mpr hb

lemma not_mem_Ioo_of_le (ha : c ≤ a) : c ∉ Ioo a b :=
not_mem_subset Ioo_subset_Ioi_self $ not_mem_Ioi.mpr ha

lemma not_mem_Ioo_of_ge (hb : b ≤ c) : c ∉ Ioo a b :=
not_mem_subset Ioo_subset_Iio_self $ not_mem_Iio.mpr hb

@[simp] lemma compl_Iic : (Iic a)ᶜ = Ioi a := ext $ λ _, not_le
@[simp] lemma compl_Ici : (Ici a)ᶜ = Iio a := ext $ λ _, not_le
@[simp] lemma compl_Iio : (Iio a)ᶜ = Ici a := ext $ λ _, not_lt
@[simp] lemma compl_Ioi : (Ioi a)ᶜ = Iic a := ext $ λ _, not_lt

@[simp] lemma Ici_diff_Ici : Ici a \ Ici b = Ico a b :=
by rw [diff_eq, compl_Ici, Ici_inter_Iio]

@[simp] lemma Ici_diff_Ioi : Ici a \ Ioi b = Icc a b :=
by rw [diff_eq, compl_Ioi, Ici_inter_Iic]

@[simp] lemma Ioi_diff_Ioi : Ioi a \ Ioi b = Ioc a b :=
by rw [diff_eq, compl_Ioi, Ioi_inter_Iic]

@[simp] lemma Ioi_diff_Ici : Ioi a \ Ici b = Ioo a b :=
by rw [diff_eq, compl_Ici, Ioi_inter_Iio]

@[simp] lemma Iic_diff_Iic : Iic b \ Iic a = Ioc a b :=
by rw [diff_eq, compl_Iic, inter_comm, Ioi_inter_Iic]

@[simp] lemma Iio_diff_Iic : Iio b \ Iic a = Ioo a b :=
by rw [diff_eq, compl_Iic, inter_comm, Ioi_inter_Iio]

@[simp] lemma Iic_diff_Iio : Iic b \ Iio a = Icc a b :=
by rw [diff_eq, compl_Iio, inter_comm, Ici_inter_Iic]

@[simp] lemma Iio_diff_Iio : Iio b \ Iio a = Ico a b :=
by rw [diff_eq, compl_Iio, inter_comm, Ici_inter_Iio]

lemma Ico_subset_Ico_iff (h₁ : a₁ < b₁) :
  Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, have a₂ ≤ a₁ ∧ a₁ < b₂ := h ⟨le_rfl, h₁⟩,
  ⟨this.1, le_of_not_lt $ λ h', lt_irrefl b₂ (h ⟨this.2.le, h'⟩).2⟩,
 λ ⟨h₁, h₂⟩, Ico_subset_Ico h₁ h₂⟩

lemma Ioc_subset_Ioc_iff (h₁ : a₁ < b₁) :
  Ioc a₁ b₁ ⊆ Ioc a₂ b₂ ↔ b₁ ≤ b₂ ∧ a₂ ≤ a₁ :=
by { convert @Ico_subset_Ico_iff (order_dual α) _ b₁ b₂ a₁ a₂ h₁; exact (@dual_Ico α _ _ _).symm }

lemma Ioo_subset_Ioo_iff [densely_ordered α] (h₁ : a₁ < b₁) :
  Ioo a₁ b₁ ⊆ Ioo a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
⟨λ h, begin
  rcases exists_between h₁ with ⟨x, xa, xb⟩,
  split; refine le_of_not_lt (λ h', _),
  { have ab := (h ⟨xa, xb⟩).1.trans xb,
    exact lt_irrefl _ (h ⟨h', ab⟩).1 },
  { have ab := xa.trans (h ⟨xa, xb⟩).2,
    exact lt_irrefl _ (h ⟨ab, h'⟩).2 }
end, λ ⟨h₁, h₂⟩, Ioo_subset_Ioo h₁ h₂⟩

lemma Ico_eq_Ico_iff (h : a₁ < b₁ ∨ a₂ < b₂) : Ico a₁ b₁ = Ico a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
⟨λ e, begin
  simp [subset.antisymm_iff] at e, simp [le_antisymm_iff],
  cases h; simp [Ico_subset_Ico_iff h] at e;
    [ rcases e with ⟨⟨h₁, h₂⟩, e'⟩, rcases e with ⟨e', ⟨h₁, h₂⟩⟩ ];
    have := (Ico_subset_Ico_iff $ h₁.trans_lt $ h.trans_le h₂).1 e';
    tauto
end, λ ⟨h₁, h₂⟩, by rw [h₁, h₂]⟩

open_locale classical

@[simp] lemma Ioi_subset_Ioi_iff : Ioi b ⊆ Ioi a ↔ a ≤ b :=
begin
  refine ⟨λ h, _, λ h, Ioi_subset_Ioi h⟩,
  by_contradiction ba,
  exact lt_irrefl _ (h (not_le.mp ba))
end

@[simp] lemma Ioi_subset_Ici_iff [densely_ordered α] : Ioi b ⊆ Ici a ↔ a ≤ b :=
begin
  refine ⟨λ h, _, λ h, Ioi_subset_Ici h⟩,
  by_contradiction ba,
  obtain ⟨c, bc, ca⟩ : ∃c, b < c ∧ c < a := exists_between (not_le.mp ba),
  exact lt_irrefl _ (ca.trans_le (h bc))
end

@[simp] lemma Iio_subset_Iio_iff : Iio a ⊆ Iio b ↔ a ≤ b :=
begin
  refine ⟨λ h, _, λ h, Iio_subset_Iio h⟩,
  by_contradiction ab,
  exact lt_irrefl _ (h (not_le.mp ab))
end

@[simp] lemma Iio_subset_Iic_iff [densely_ordered α] : Iio a ⊆ Iic b ↔ a ≤ b :=
by rw [←diff_eq_empty, Iio_diff_Iic, Ioo_eq_empty_iff, not_lt]

/-! ### Unions of adjacent intervals -/

/-! #### Two infinite intervals -/

@[simp] lemma Iic_union_Ici : Iic a ∪ Ici a = univ := eq_univ_of_forall (λ x, le_total x a)

@[simp] lemma Iio_union_Ici : Iio a ∪ Ici a = univ := eq_univ_of_forall (λ x, lt_or_le x a)

@[simp] lemma Iic_union_Ioi : Iic a ∪ Ioi a = univ := eq_univ_of_forall (λ x, le_or_lt x a)

/-! #### A finite and an infinite interval -/

lemma Ioo_union_Ioi' (h₁ : c < b) :
  Ioo a b ∪ Ioi c = Ioi (min a c) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Ioo, mem_Ioi, min_lt_iff],
  by_cases hc : c < x,
  { tauto },
  { have hxb : x < b := (le_of_not_gt hc).trans_lt h₁,
    tauto },
end

lemma Ioo_union_Ioi (h : c < max a b) :
  Ioo a b ∪ Ioi c = Ioi (min a c) :=
begin
  cases le_total a b with hab hab; simp [hab] at h,
  { exact Ioo_union_Ioi' h },
  { rw min_comm,
    simp [*, min_eq_left_of_lt] },
end

lemma Ioi_subset_Ioo_union_Ici : Ioi a ⊆ Ioo a b ∪ Ici b :=
λ x hx, (lt_or_le x b).elim (λ hxb, or.inl ⟨hx, hxb⟩) (λ hxb, or.inr hxb)

@[simp] lemma Ioo_union_Ici_eq_Ioi (h : a < b) : Ioo a b ∪ Ici b = Ioi a :=
subset.antisymm (λ x hx, hx.elim and.left h.trans_le) Ioi_subset_Ioo_union_Ici

lemma Ici_subset_Ico_union_Ici : Ici a ⊆ Ico a b ∪ Ici b :=
λ x hx, (lt_or_le x b).elim (λ hxb, or.inl ⟨hx, hxb⟩) (λ hxb, or.inr hxb)

@[simp] lemma Ico_union_Ici_eq_Ici (h : a ≤ b) : Ico a b ∪ Ici b = Ici a :=
subset.antisymm (λ x hx, hx.elim and.left h.trans) Ici_subset_Ico_union_Ici

lemma Ico_union_Ici' (h₁ : c ≤ b) :
  Ico a b ∪ Ici c = Ici (min a c) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Ico, mem_Ici, min_le_iff],
  by_cases hc : c ≤ x,
  { tauto },
  { have hxb : x < b := (lt_of_not_ge hc).trans_le h₁,
    tauto },
end

lemma Ico_union_Ici  (h : c ≤ max a b) :
  Ico a b ∪ Ici c = Ici (min a c) :=
begin
  cases le_total a b with hab hab; simp [hab] at h,
  { exact Ico_union_Ici' h },
  { simp [*] },
end

lemma Ioi_subset_Ioc_union_Ioi : Ioi a ⊆ Ioc a b ∪ Ioi b :=
λ x hx, (le_or_lt x b).elim (λ hxb, or.inl ⟨hx, hxb⟩) (λ hxb, or.inr hxb)

@[simp] lemma Ioc_union_Ioi_eq_Ioi (h : a ≤ b) : Ioc a b ∪ Ioi b = Ioi a :=
subset.antisymm (λ x hx, hx.elim and.left h.trans_lt) Ioi_subset_Ioc_union_Ioi

lemma Ioc_union_Ioi' (h₁ : c ≤ b) :
  Ioc a b ∪ Ioi c = Ioi (min a c) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Ioc, mem_Ioi, min_lt_iff],
  by_cases hc : c < x,
  { tauto },
  { have hxb : x ≤ b := (le_of_not_gt hc).trans h₁,
    tauto },
end

lemma Ioc_union_Ioi (h : c ≤ max a b) :
  Ioc a b ∪ Ioi c = Ioi (min a c) :=
begin
  cases le_total a b with hab hab; simp [hab] at h,
  { exact Ioc_union_Ioi' h },
  { simp [*] },
end

lemma Ici_subset_Icc_union_Ioi : Ici a ⊆ Icc a b ∪ Ioi b :=
λ x hx, (le_or_lt x b).elim (λ hxb, or.inl ⟨hx, hxb⟩) (λ hxb, or.inr hxb)

@[simp] lemma Icc_union_Ioi_eq_Ici (h : a ≤ b) : Icc a b ∪ Ioi b = Ici a :=
subset.antisymm (λ x hx, hx.elim and.left $ λ hx', h.trans $ le_of_lt hx') Ici_subset_Icc_union_Ioi

lemma Ioi_subset_Ioc_union_Ici : Ioi a ⊆ Ioc a b ∪ Ici b :=
subset.trans Ioi_subset_Ioo_union_Ici (union_subset_union_left _ Ioo_subset_Ioc_self)

@[simp] lemma Ioc_union_Ici_eq_Ioi (h : a < b) : Ioc a b ∪ Ici b = Ioi a :=
subset.antisymm (λ x hx, hx.elim and.left h.trans_le) Ioi_subset_Ioc_union_Ici

lemma Ici_subset_Icc_union_Ici : Ici a ⊆ Icc a b ∪ Ici b :=
subset.trans Ici_subset_Ico_union_Ici (union_subset_union_left _ Ico_subset_Icc_self)

@[simp] lemma Icc_union_Ici_eq_Ici (h : a ≤ b) : Icc a b ∪ Ici b = Ici a :=
subset.antisymm (λ x hx, hx.elim and.left h.trans) Ici_subset_Icc_union_Ici

lemma Icc_union_Ici' (h₁ : c ≤ b) :
  Icc a b ∪ Ici c = Ici (min a c) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Icc, mem_Ici, min_le_iff],
  by_cases hc : c ≤ x,
  { tauto },
  { have hxb : x ≤ b := (le_of_not_ge hc).trans h₁,
    tauto },
end

lemma Icc_union_Ici (h : c ≤ max a b) :
  Icc a b ∪ Ici c = Ici (min a c) :=
begin
  cases le_or_lt a b with hab hab; simp [hab] at h,
  { exact Icc_union_Ici' h },
  { cases h,
    { simp [*] },
    { have hca : c ≤ a := h.trans hab.le,
      simp [*] } },
end

/-! #### An infinite and a finite interval -/

lemma Iic_subset_Iio_union_Icc : Iic b ⊆ Iio a ∪ Icc a b :=
λ x hx, (lt_or_le x a).elim (λ hxa, or.inl hxa) (λ hxa, or.inr ⟨hxa, hx⟩)

@[simp] lemma Iio_union_Icc_eq_Iic (h : a ≤ b) : Iio a ∪ Icc a b = Iic b :=
subset.antisymm (λ x hx, hx.elim (λ hx, (le_of_lt hx).trans h) and.right)
  Iic_subset_Iio_union_Icc

lemma Iio_subset_Iio_union_Ico : Iio b ⊆ Iio a ∪ Ico a b :=
λ x hx, (lt_or_le x a).elim (λ hxa, or.inl hxa) (λ hxa, or.inr ⟨hxa, hx⟩)

@[simp] lemma Iio_union_Ico_eq_Iio (h : a ≤ b) : Iio a ∪ Ico a b = Iio b :=
subset.antisymm (λ x hx, hx.elim (λ hx', lt_of_lt_of_le hx' h) and.right) Iio_subset_Iio_union_Ico

lemma Iio_union_Ico' (h₁ : c ≤ b) :
  Iio b ∪ Ico c d = Iio (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Iio, mem_Ico, lt_max_iff],
  by_cases hc : c ≤ x,
  { tauto },
  { have hxb : x < b := (lt_of_not_ge hc).trans_le h₁,
    tauto },
end

lemma Iio_union_Ico (h : min c d ≤ b) :
  Iio b ∪ Ico c d = Iio (max b d) :=
begin
  cases le_total c d with hcd hcd; simp [hcd] at h,
  { exact Iio_union_Ico' h },
  { simp [*] },
end

lemma Iic_subset_Iic_union_Ioc : Iic b ⊆ Iic a ∪ Ioc a b :=
λ x hx, (le_or_lt x a).elim (λ hxa, or.inl hxa) (λ hxa, or.inr ⟨hxa, hx⟩)

@[simp] lemma Iic_union_Ioc_eq_Iic (h : a ≤ b) : Iic a ∪ Ioc a b = Iic b :=
subset.antisymm (λ x hx, hx.elim (λ hx', le_trans hx' h) and.right) Iic_subset_Iic_union_Ioc

lemma Iic_union_Ioc' (h₁ : c < b) :
  Iic b ∪ Ioc c d = Iic (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Iic, mem_Ioc, le_max_iff],
  by_cases hc : c < x,
  { tauto },
  { have hxb : x ≤ b := (le_of_not_gt hc).trans h₁.le,
    tauto },
end

lemma Iic_union_Ioc (h : min c d < b) :
  Iic b ∪ Ioc c d = Iic (max b d) :=
begin
  cases le_total c d with hcd hcd; simp [hcd] at h,
  { exact Iic_union_Ioc' h },
  { rw max_comm,
    simp [*, max_eq_right_of_lt h] },
end

lemma Iio_subset_Iic_union_Ioo : Iio b ⊆ Iic a ∪ Ioo a b :=
λ x hx, (le_or_lt x a).elim (λ hxa, or.inl hxa) (λ hxa, or.inr ⟨hxa, hx⟩)

@[simp] lemma Iic_union_Ioo_eq_Iio (h : a < b) : Iic a ∪ Ioo a b = Iio b :=
subset.antisymm (λ x hx, hx.elim (λ hx', lt_of_le_of_lt hx' h) and.right) Iio_subset_Iic_union_Ioo

lemma Iio_union_Ioo' (h₁ : c < b) :
  Iio b ∪ Ioo c d = Iio (max b d) :=
begin
  ext x,
  cases lt_or_le x b with hba hba,
  { simp [hba, h₁] },
  { simp only [mem_Iio, mem_union_eq, mem_Ioo, lt_max_iff],
    refine or_congr iff.rfl ⟨and.right, _⟩,
    exact λ h₂, ⟨h₁.trans_le hba, h₂⟩ },
end

lemma Iio_union_Ioo (h : min c d < b) :
  Iio b ∪ Ioo c d = Iio (max b d) :=
begin
  cases le_total c d with hcd hcd; simp [hcd] at h,
  { exact Iio_union_Ioo' h },
  { rw max_comm,
    simp [*, max_eq_right_of_lt h] },
end

lemma Iic_subset_Iic_union_Icc : Iic b ⊆ Iic a ∪ Icc a b :=
subset.trans Iic_subset_Iic_union_Ioc (union_subset_union_right _ Ioc_subset_Icc_self)

@[simp] lemma Iic_union_Icc_eq_Iic (h : a ≤ b) : Iic a ∪ Icc a b = Iic b :=
subset.antisymm (λ x hx, hx.elim (λ hx', le_trans hx' h) and.right) Iic_subset_Iic_union_Icc

lemma Iic_union_Icc' (h₁ : c ≤ b) :
  Iic b ∪ Icc c d = Iic (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Iic, mem_Icc, le_max_iff],
  by_cases hc : c ≤ x,
  { tauto },
  { have hxb : x ≤ b := (le_of_not_ge hc).trans h₁,
    tauto },
end

lemma Iic_union_Icc (h : min c d ≤ b) :
  Iic b ∪ Icc c d = Iic (max b d) :=
begin
  cases le_or_lt c d with hcd hcd; simp [hcd] at h,
  { exact Iic_union_Icc' h },
  { cases h,
    { have hdb : d ≤ b := hcd.le.trans h,
      simp [*] },
    { simp [*] } },
end

lemma Iio_subset_Iic_union_Ico : Iio b ⊆ Iic a ∪ Ico a b :=
subset.trans Iio_subset_Iic_union_Ioo (union_subset_union_right _ Ioo_subset_Ico_self)

@[simp] lemma Iic_union_Ico_eq_Iio (h : a < b) : Iic a ∪ Ico a b = Iio b :=
subset.antisymm (λ x hx, hx.elim (λ hx', lt_of_le_of_lt hx' h) and.right) Iio_subset_Iic_union_Ico

/-! #### Two finite intervals, `I?o` and `Ic?` -/

lemma Ioo_subset_Ioo_union_Ico : Ioo a c ⊆ Ioo a b ∪ Ico b c :=
λ x hx, (lt_or_le x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Ioo_union_Ico_eq_Ioo (h₁ : a < b) (h₂ : b ≤ c) : Ioo a b ∪ Ico b c = Ioo a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans_le h₂⟩) (λ hx, ⟨h₁.trans_le hx.1, hx.2⟩))
  Ioo_subset_Ioo_union_Ico

lemma Ico_subset_Ico_union_Ico : Ico a c ⊆ Ico a b ∪ Ico b c :=
λ x hx, (lt_or_le x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Ico_union_Ico_eq_Ico (h₁ : a ≤ b) (h₂ : b ≤ c) : Ico a b ∪ Ico b c = Ico a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans_le h₂⟩) (λ hx, ⟨h₁.trans hx.1, hx.2⟩))
  Ico_subset_Ico_union_Ico

lemma Ico_union_Ico' (h₁ : c ≤ b) (h₂ : a ≤ d) :
  Ico a b ∪ Ico c d = Ico (min a c) (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Ico, min_le_iff, lt_max_iff],
  by_cases hc : c ≤ x; by_cases hd : x < d,
  { tauto },
  { have hax : a ≤ x := h₂.trans (le_of_not_gt hd),
    tauto },
  { have hxb : x < b := (lt_of_not_ge hc).trans_le h₁,
    tauto },
  { tauto },
end

lemma Ico_union_Ico (h₁ : min a b ≤ max c d) (h₂ : min c d ≤ max a b) :
  Ico a b ∪ Ico c d = Ico (min a c) (max b d) :=
begin
  cases le_total a b with hab hab; cases le_total c d with hcd hcd; simp [hab, hcd] at h₁ h₂,
  { exact Ico_union_Ico' h₂ h₁ },
  all_goals { simp [*] },
end

lemma Icc_subset_Ico_union_Icc : Icc a c ⊆ Ico a b ∪ Icc b c :=
λ x hx, (lt_or_le x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Ico_union_Icc_eq_Icc (h₁ : a ≤ b) (h₂ : b ≤ c) : Ico a b ∪ Icc b c = Icc a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.le.trans h₂⟩) (λ hx, ⟨h₁.trans hx.1, hx.2⟩))
  Icc_subset_Ico_union_Icc

lemma Ioc_subset_Ioo_union_Icc : Ioc a c ⊆ Ioo a b ∪ Icc b c :=
λ x hx, (lt_or_le x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Ioo_union_Icc_eq_Ioc (h₁ : a < b) (h₂ : b ≤ c) : Ioo a b ∪ Icc b c = Ioc a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.le.trans h₂⟩)
    (λ hx, ⟨h₁.trans_le hx.1, hx.2⟩))
  Ioc_subset_Ioo_union_Icc

/-! #### Two finite intervals, `I?c` and `Io?` -/

lemma Ioo_subset_Ioc_union_Ioo : Ioo a c ⊆ Ioc a b ∪ Ioo b c :=
λ x hx, (le_or_lt x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Ioc_union_Ioo_eq_Ioo (h₁ : a ≤ b) (h₂ : b < c) : Ioc a b ∪ Ioo b c = Ioo a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans_lt h₂⟩) (λ hx, ⟨h₁.trans_lt hx.1, hx.2⟩))
  Ioo_subset_Ioc_union_Ioo

lemma Ico_subset_Icc_union_Ioo : Ico a c ⊆ Icc a b ∪ Ioo b c :=
λ x hx, (le_or_lt x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Icc_union_Ioo_eq_Ico (h₁ : a ≤ b) (h₂ : b < c) : Icc a b ∪ Ioo b c = Ico a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans_lt h₂⟩)
    (λ hx, ⟨h₁.trans hx.1.le, hx.2⟩))
  Ico_subset_Icc_union_Ioo

lemma Icc_subset_Icc_union_Ioc : Icc a c ⊆ Icc a b ∪ Ioc b c :=
λ x hx, (le_or_lt x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Icc_union_Ioc_eq_Icc (h₁ : a ≤ b) (h₂ : b ≤ c) : Icc a b ∪ Ioc b c = Icc a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans h₂⟩) (λ hx, ⟨h₁.trans hx.1.le, hx.2⟩))
  Icc_subset_Icc_union_Ioc

lemma Ioc_subset_Ioc_union_Ioc : Ioc a c ⊆ Ioc a b ∪ Ioc b c :=
λ x hx, (le_or_lt x b).elim (λ hxb, or.inl ⟨hx.1, hxb⟩) (λ hxb, or.inr ⟨hxb, hx.2⟩)

@[simp] lemma Ioc_union_Ioc_eq_Ioc (h₁ : a ≤ b) (h₂ : b ≤ c) : Ioc a b ∪ Ioc b c = Ioc a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans h₂⟩) (λ hx, ⟨h₁.trans_lt hx.1, hx.2⟩))
  Ioc_subset_Ioc_union_Ioc

lemma Ioc_union_Ioc' (h₁ : c ≤ b) (h₂ : a ≤ d) :
  Ioc a b ∪ Ioc c d = Ioc (min a c) (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Ioc, min_lt_iff, le_max_iff],
  by_cases hc : c < x; by_cases hd : x ≤ d,
  { tauto },
  { have hax : a < x := h₂.trans_lt (lt_of_not_ge hd),
    tauto },
  { have hxb : x ≤ b := (le_of_not_gt hc).trans h₁,
    tauto },
  { tauto },
end

lemma Ioc_union_Ioc (h₁ : min a b ≤ max c d) (h₂ : min c d ≤ max a b) :
  Ioc a b ∪ Ioc c d = Ioc (min a c) (max b d) :=
begin
  cases le_total a b with hab hab; cases le_total c d with hcd hcd; simp [hab, hcd] at h₁ h₂,
  { exact Ioc_union_Ioc' h₂ h₁ },
  all_goals { simp [*] },
end

/-! #### Two finite intervals with a common point -/

lemma Ioo_subset_Ioc_union_Ico : Ioo a c ⊆ Ioc a b ∪ Ico b c :=
subset.trans Ioo_subset_Ioc_union_Ioo (union_subset_union_right _ Ioo_subset_Ico_self)

@[simp] lemma Ioc_union_Ico_eq_Ioo (h₁ : a < b) (h₂ : b < c) : Ioc a b ∪ Ico b c = Ioo a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx', ⟨hx'.1, hx'.2.trans_lt h₂⟩) (λ hx', ⟨h₁.trans_le hx'.1, hx'.2⟩))
  Ioo_subset_Ioc_union_Ico

lemma Ico_subset_Icc_union_Ico : Ico a c ⊆ Icc a b ∪ Ico b c :=
subset.trans Ico_subset_Icc_union_Ioo (union_subset_union_right _ Ioo_subset_Ico_self)

@[simp] lemma Icc_union_Ico_eq_Ico (h₁ : a ≤ b) (h₂ : b < c) : Icc a b ∪ Ico b c = Ico a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans_lt h₂⟩) (λ hx, ⟨h₁.trans hx.1, hx.2⟩))
  Ico_subset_Icc_union_Ico

@[simp] lemma Icc_union_Icc_eq_Icc (h₁ : a ≤ b) (h₂ : b ≤ c) : Icc a b ∪ Icc b c = Icc a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans h₂⟩) (λ hx, ⟨h₁.trans hx.1, hx.2⟩))
  Icc_subset_Icc_union_Icc

lemma Icc_union_Icc' (h₁ : c ≤ b) (h₂ : a ≤ d) :
  Icc a b ∪ Icc c d = Icc (min a c) (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Icc, min_le_iff, le_max_iff],
  by_cases hc : c ≤ x; by_cases hd : x ≤ d,
  { tauto },
  { have hax : a ≤ x := h₂.trans (le_of_not_ge hd),
    tauto },
  { have hxb : x ≤ b := (le_of_not_ge hc).trans h₁,
    tauto },
  { tauto }
end

/--
We cannot replace `<` by `≤` in the hypotheses.
Otherwise for `b < a = d < c` the l.h.s. is `∅` and the r.h.s. is `{a}`.
-/
lemma Icc_union_Icc (h₁ : min a b < max c d) (h₂ : min c d < max a b) :
  Icc a b ∪ Icc c d = Icc (min a c) (max b d) :=
begin
  cases le_or_lt a b with hab hab; cases le_or_lt c d with hcd hcd;
    simp only [min_eq_left, min_eq_right, max_eq_left, max_eq_right, min_eq_left_of_lt,
    min_eq_right_of_lt, max_eq_left_of_lt, max_eq_right_of_lt, hab, hcd] at h₁ h₂,
  { exact Icc_union_Icc' h₂.le h₁.le },
  all_goals { simp [*, min_eq_left_of_lt, max_eq_left_of_lt, min_eq_right_of_lt,
    max_eq_right_of_lt] },
end

lemma Ioc_subset_Ioc_union_Icc : Ioc a c ⊆ Ioc a b ∪ Icc b c :=
subset.trans Ioc_subset_Ioc_union_Ioc (union_subset_union_right _ Ioc_subset_Icc_self)

@[simp] lemma Ioc_union_Icc_eq_Ioc (h₁ : a < b) (h₂ : b ≤ c) : Ioc a b ∪ Icc b c = Ioc a c :=
subset.antisymm
  (λ x hx, hx.elim (λ hx, ⟨hx.1, hx.2.trans h₂⟩) (λ hx, ⟨h₁.trans_le hx.1, hx.2⟩))
  Ioc_subset_Ioc_union_Icc

lemma Ioo_union_Ioo' (h₁ : c < b) (h₂ : a < d) :
  Ioo a b ∪ Ioo c d = Ioo (min a c) (max b d) :=
begin
  ext1 x,
  simp_rw [mem_union, mem_Ioo, min_lt_iff, lt_max_iff],
  by_cases hc : c < x; by_cases hd : x < d,
  { tauto },
  { have hax : a < x := h₂.trans_le (le_of_not_lt hd),
    tauto },
  { have hxb : x < b := (le_of_not_lt hc).trans_lt h₁,
    tauto },
  { tauto }
end

lemma Ioo_union_Ioo (h₁ : min a b < max c d) (h₂ : min c d < max a b) :
  Ioo a b ∪ Ioo c d = Ioo (min a c) (max b d) :=
begin
  cases le_total a b with hab hab; cases le_total c d with hcd hcd;
    simp only [min_eq_left, min_eq_right, max_eq_left, max_eq_right, hab, hcd] at h₁ h₂,
  { exact Ioo_union_Ioo' h₂ h₁ },
  all_goals
  { simp [*, min_eq_left_of_lt, min_eq_right_of_lt, max_eq_left_of_lt, max_eq_right_of_lt,
      le_of_lt h₂, le_of_lt h₁] },
end

end linear_order

section lattice

section inf

variables {α : Type u} [semilattice_inf α]

@[simp] lemma Iic_inter_Iic {a b : α} : Iic a ∩ Iic b = Iic (a ⊓ b) :=
by { ext x, simp [Iic] }

@[simp] lemma Iio_inter_Iio [is_total α (≤)] {a b : α} : Iio a ∩ Iio b = Iio (a ⊓ b) :=
by { ext x, simp [Iio] }

@[simp] lemma Ioc_inter_Iic (a b c : α) : Ioc a b ∩ Iic c = Ioc a (b ⊓ c) :=
by rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, inter_assoc, Iic_inter_Iic]

end inf

section sup

variables {α : Type u} [semilattice_sup α]

@[simp] lemma Ici_inter_Ici {a b : α} : Ici a ∩ Ici b = Ici (a ⊔ b) :=
by { ext x, simp [Ici] }

@[simp] lemma Ico_inter_Ici (a b c : α) : Ico a b ∩ Ici c = Ico (a ⊔ c) b :=
by rw [← Ici_inter_Iio, ← Ici_inter_Iio, ← Ici_inter_Ici, inter_right_comm]

@[simp] lemma Ioi_inter_Ioi [is_total α (≤)] {a b : α} : Ioi a ∩ Ioi b = Ioi (a ⊔ b) :=
by { ext x, simp [Ioi] }

@[simp] lemma Ioc_inter_Ioi [is_total α (≤)] {a b c : α} : Ioc a b ∩ Ioi c = Ioc (a ⊔ c) b :=
by rw [← Ioi_inter_Iic, inter_assoc, inter_comm, inter_assoc, Ioi_inter_Ioi, inter_comm,
  Ioi_inter_Iic, sup_comm]

end sup

section both

variables {α : Type u} [lattice α] [ht : is_total α (≤)] {a b c a₁ a₂ b₁ b₂ : α}

lemma Icc_inter_Icc : Icc a₁ b₁ ∩ Icc a₂ b₂ = Icc (a₁ ⊔ a₂) (b₁ ⊓ b₂) :=
by simp only [Ici_inter_Iic.symm, Ici_inter_Ici.symm, Iic_inter_Iic.symm]; ac_refl

@[simp] lemma Icc_inter_Icc_eq_singleton (hab : a ≤ b) (hbc : b ≤ c) :
  Icc a b ∩ Icc b c = {b} :=
by rw [Icc_inter_Icc, sup_of_le_right hab, inf_of_le_left hbc, Icc_self]

include ht

lemma Ico_inter_Ico : Ico a₁ b₁ ∩ Ico a₂ b₂ = Ico (a₁ ⊔ a₂) (b₁ ⊓ b₂) :=
by simp only [Ici_inter_Iio.symm, Ici_inter_Ici.symm, Iio_inter_Iio.symm]; ac_refl

lemma Ioc_inter_Ioc : Ioc a₁ b₁ ∩ Ioc a₂ b₂ = Ioc (a₁ ⊔ a₂) (b₁ ⊓ b₂) :=
by simp only [Ioi_inter_Iic.symm, Ioi_inter_Ioi.symm, Iic_inter_Iic.symm]; ac_refl

lemma Ioo_inter_Ioo : Ioo a₁ b₁ ∩ Ioo a₂ b₂ = Ioo (a₁ ⊔ a₂) (b₁ ⊓ b₂) :=
by simp only [Ioi_inter_Iio.symm, Ioi_inter_Ioi.symm, Iio_inter_Iio.symm]; ac_refl

end both

lemma Icc_bot_top {α} [partial_order α] [bounded_order α] : Icc (⊥ : α) ⊤ = univ := by simp

end lattice

section linear_order
variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ c d : α}

lemma Ioc_inter_Ioo_of_left_lt (h : b₁ < b₂) : Ioc a₁ b₁ ∩ Ioo a₂ b₂ = Ioc (max a₁ a₂) b₁ :=
ext $ λ x, by simp [and_assoc, @and.left_comm (x ≤ _),
  and_iff_left_iff_imp.2 (λ h', lt_of_le_of_lt h' h)]

lemma Ioc_inter_Ioo_of_right_le (h : b₂ ≤ b₁) : Ioc a₁ b₁ ∩ Ioo a₂ b₂ = Ioo (max a₁ a₂) b₂ :=
ext $ λ x, by simp [and_assoc, @and.left_comm (x ≤ _),
  and_iff_right_iff_imp.2 (λ h', ((le_of_lt h').trans h))]

lemma Ioo_inter_Ioc_of_left_le (h : b₁ ≤ b₂) : Ioo a₁ b₁ ∩ Ioc a₂ b₂ = Ioo (max a₁ a₂) b₁ :=
by rw [inter_comm, Ioc_inter_Ioo_of_right_le h, max_comm]

lemma Ioo_inter_Ioc_of_right_lt (h : b₂ < b₁) : Ioo a₁ b₁ ∩ Ioc a₂ b₂ = Ioc (max a₁ a₂) b₂ :=
by rw [inter_comm, Ioc_inter_Ioo_of_left_lt h, max_comm]

@[simp] lemma Ico_diff_Iio : Ico a b \ Iio c = Ico (max a c) b :=
by rw [diff_eq, compl_Iio, Ico_inter_Ici, sup_eq_max]

@[simp] lemma Ioc_diff_Ioi : Ioc a b \ Ioi c = Ioc a (min b c) :=
ext $ by simp [iff_def] {contextual:=tt}

@[simp] lemma Ico_inter_Iio : Ico a b ∩ Iio c = Ico a (min b c) :=
ext $ by simp [iff_def] {contextual:=tt}

@[simp] lemma Ioc_diff_Iic : Ioc a b \ Iic c = Ioc (max a c) b :=
by rw [diff_eq, compl_Iic, Ioc_inter_Ioi, sup_eq_max]

@[simp] lemma Ioc_union_Ioc_right : Ioc a b ∪ Ioc a c = Ioc a (max b c) :=
by rw [Ioc_union_Ioc, min_self]; exact (min_le_left _ _).trans (le_max_left _ _)

@[simp] lemma Ioc_union_Ioc_left : Ioc a c ∪ Ioc b c = Ioc (min a b) c :=
by rw [Ioc_union_Ioc, max_self]; exact (min_le_right _ _).trans (le_max_right _ _)

@[simp] lemma Ioc_union_Ioc_symm : Ioc a b ∪ Ioc b a = Ioc (min a b) (max a b) :=
by { rw max_comm, apply Ioc_union_Ioc; rw max_comm; exact min_le_max }

@[simp] lemma Ioc_union_Ioc_union_Ioc_cycle :
  Ioc a b ∪ Ioc b c ∪ Ioc c a = Ioc (min a (min b c)) (max a (max b c)) :=
begin
  rw [Ioc_union_Ioc, Ioc_union_Ioc],
  ac_refl,
  all_goals { solve_by_elim [min_le_of_left_le, min_le_of_right_le, le_max_of_le_left,
    le_max_of_le_right, le_refl] { max_depth := 5 }}
end

end linear_order

/-!
### Closed intervals in `α × β`
-/

section prod

variables {α β : Type*} [preorder α] [preorder β]

@[simp] lemma Iic_prod_Iic (a : α) (b : β) : Iic a ×ˢ Iic b = Iic (a, b) := rfl

@[simp] lemma Ici_prod_Ici (a : α) (b : β) : Ici a ×ˢ Ici b = Ici (a, b) := rfl

lemma Ici_prod_eq (a : α × β) : Ici a = Ici a.1 ×ˢ Ici a.2 := rfl

lemma Iic_prod_eq (a : α × β) : Iic a = Iic a.1 ×ˢ Iic a.2 := rfl

@[simp] lemma Icc_prod_Icc (a₁ a₂ : α) (b₁ b₂ : β) :
  Icc a₁ a₂ ×ˢ Icc b₁ b₂ = Icc (a₁, b₁) (a₂, b₂) :=
by { ext ⟨x, y⟩, simp [and.assoc, and_comm, and.left_comm] }

lemma Icc_prod_eq (a b : α × β) :
  Icc a b = Icc a.1 b.1 ×ˢ Icc a.2 b.2 :=
by simp

end prod

/-! ### Lemmas about membership of arithmetic operations -/

section ordered_comm_group

variables {α : Type*} [ordered_comm_group α] {a b c d : α}

/-! `inv_mem_Ixx_iff`, `sub_mem_Ixx_iff` -/
@[to_additive] lemma inv_mem_Icc_iff : a⁻¹ ∈ set.Icc c d ↔ a ∈ set.Icc (d⁻¹) (c⁻¹) :=
(and_comm _ _).trans $ and_congr inv_le' le_inv'
@[to_additive] lemma inv_mem_Ico_iff : a⁻¹ ∈ set.Ico c d ↔ a ∈ set.Ioc (d⁻¹) (c⁻¹) :=
(and_comm _ _).trans $ and_congr inv_lt' le_inv'
@[to_additive] lemma inv_mem_Ioc_iff : a⁻¹ ∈ set.Ioc c d ↔ a ∈ set.Ico (d⁻¹) (c⁻¹) :=
(and_comm _ _).trans $ and_congr inv_le' lt_inv'
@[to_additive] lemma inv_mem_Ioo_iff : a⁻¹ ∈ set.Ioo c d ↔ a ∈ set.Ioo (d⁻¹) (c⁻¹) :=
(and_comm _ _).trans $ and_congr inv_lt' lt_inv'

end ordered_comm_group

section ordered_add_comm_group

variables {α : Type*} [ordered_add_comm_group α] {a b c d : α}

/-! `add_mem_Ixx_iff_left` -/
lemma add_mem_Icc_iff_left : a + b ∈ set.Icc c d ↔ a ∈ set.Icc (c - b) (d - b) :=
(and_congr sub_le_iff_le_add le_sub_iff_add_le).symm
lemma add_mem_Ico_iff_left : a + b ∈ set.Ico c d ↔ a ∈ set.Ico (c - b) (d - b) :=
(and_congr sub_le_iff_le_add lt_sub_iff_add_lt).symm
lemma add_mem_Ioc_iff_left : a + b ∈ set.Ioc c d ↔ a ∈ set.Ioc (c - b) (d - b) :=
(and_congr sub_lt_iff_lt_add le_sub_iff_add_le).symm
lemma add_mem_Ioo_iff_left : a + b ∈ set.Ioo c d ↔ a ∈ set.Ioo (c - b) (d - b) :=
(and_congr sub_lt_iff_lt_add lt_sub_iff_add_lt).symm

/-! `add_mem_Ixx_iff_right` -/
lemma add_mem_Icc_iff_right : a + b ∈ set.Icc c d ↔ b ∈ set.Icc (c - a) (d - a) :=
(and_congr sub_le_iff_le_add' le_sub_iff_add_le').symm
lemma add_mem_Ico_iff_right : a + b ∈ set.Ico c d ↔ b ∈ set.Ico (c - a) (d - a) :=
(and_congr sub_le_iff_le_add' lt_sub_iff_add_lt').symm
lemma add_mem_Ioc_iff_right : a + b ∈ set.Ioc c d ↔ b ∈ set.Ioc (c - a) (d - a) :=
(and_congr sub_lt_iff_lt_add' le_sub_iff_add_le').symm
lemma add_mem_Ioo_iff_right : a + b ∈ set.Ioo c d ↔ b ∈ set.Ioo (c - a) (d - a) :=
(and_congr sub_lt_iff_lt_add' lt_sub_iff_add_lt').symm

/-! `sub_mem_Ixx_iff_left` -/
lemma sub_mem_Icc_iff_left : a - b ∈ set.Icc c d ↔ a ∈ set.Icc (c + b) (d + b) :=
and_congr le_sub_iff_add_le sub_le_iff_le_add
lemma sub_mem_Ico_iff_left : a - b ∈ set.Ico c d ↔ a ∈ set.Ico (c + b) (d + b) :=
and_congr le_sub_iff_add_le sub_lt_iff_lt_add
lemma sub_mem_Ioc_iff_left : a - b ∈ set.Ioc c d ↔ a ∈ set.Ioc (c + b) (d + b) :=
and_congr lt_sub_iff_add_lt sub_le_iff_le_add
lemma sub_mem_Ioo_iff_left : a - b ∈ set.Ioo c d ↔ a ∈ set.Ioo (c + b) (d + b) :=
and_congr lt_sub_iff_add_lt sub_lt_iff_lt_add

/-! `sub_mem_Ixx_iff_right` -/
lemma sub_mem_Icc_iff_right : a - b ∈ set.Icc c d ↔ b ∈ set.Icc (a - d) (a - c) :=
(and_comm _ _).trans $ and_congr sub_le le_sub
lemma sub_mem_Ico_iff_right : a - b ∈ set.Ico c d ↔ b ∈ set.Ioc (a - d) (a - c) :=
(and_comm _ _).trans $ and_congr sub_lt le_sub
lemma sub_mem_Ioc_iff_right : a - b ∈ set.Ioc c d ↔ b ∈ set.Ico (a - d) (a - c) :=
(and_comm _ _).trans $ and_congr sub_le lt_sub
lemma sub_mem_Ioo_iff_right : a - b ∈ set.Ioo c d ↔ b ∈ set.Ioo (a - d) (a - c) :=
(and_comm _ _).trans $ and_congr sub_lt lt_sub

-- I think that symmetric intervals deserve attention and API: they arise all the time,
-- for instance when considering metric balls in `ℝ`.
lemma mem_Icc_iff_abs_le {R : Type*} [linear_ordered_add_comm_group R] {x y z : R} :
  |x - y| ≤ z ↔ y ∈ Icc (x - z) (x + z) :=
abs_le.trans $ (and_comm _ _).trans $ and_congr sub_le neg_le_sub_iff_le_add

end ordered_add_comm_group

section linear_ordered_add_comm_group

variables {α : Type u} [linear_ordered_add_comm_group α]

/-- If we remove a smaller interval from a larger, the result is nonempty -/
lemma nonempty_Ico_sdiff {x dx y dy : α} (h : dy < dx) (hx : 0 < dx) :
  nonempty ↥(Ico x (x + dx) \ Ico y (y + dy)) :=
begin
  cases lt_or_le x y with h' h',
  { use x, simp [*, not_le.2 h'] },
  { use max x (x + dy), simp [*, le_refl] }
end

end linear_ordered_add_comm_group

end set

open set

namespace order_iso
variables {α β : Type*}

section preorder
variables [preorder α] [preorder β]

@[simp] lemma preimage_Iic (e : α ≃o β) (b : β) : e ⁻¹' (Iic b) = Iic (e.symm b) :=
by { ext x, simp [← e.le_iff_le] }

@[simp] lemma preimage_Ici (e : α ≃o β) (b : β) : e ⁻¹' (Ici b) = Ici (e.symm b) :=
by { ext x, simp [← e.le_iff_le] }

@[simp] lemma preimage_Iio (e : α ≃o β) (b : β) : e ⁻¹' (Iio b) = Iio (e.symm b) :=
by { ext x, simp [← e.lt_iff_lt] }

@[simp] lemma preimage_Ioi (e : α ≃o β) (b : β) : e ⁻¹' (Ioi b) = Ioi (e.symm b) :=
by { ext x, simp [← e.lt_iff_lt] }

@[simp] lemma preimage_Icc (e : α ≃o β) (a b : β) : e ⁻¹' (Icc a b) = Icc (e.symm a) (e.symm b) :=
by simp [← Ici_inter_Iic]

@[simp] lemma preimage_Ico (e : α ≃o β) (a b : β) : e ⁻¹' (Ico a b) = Ico (e.symm a) (e.symm b) :=
by simp [← Ici_inter_Iio]

@[simp] lemma preimage_Ioc (e : α ≃o β) (a b : β) : e ⁻¹' (Ioc a b) = Ioc (e.symm a) (e.symm b) :=
by simp [← Ioi_inter_Iic]

@[simp] lemma preimage_Ioo (e : α ≃o β) (a b : β) : e ⁻¹' (Ioo a b) = Ioo (e.symm a) (e.symm b) :=
by simp [← Ioi_inter_Iio]

@[simp] lemma image_Iic (e : α ≃o β) (a : α) : e '' (Iic a) = Iic (e a) :=
by rw [e.image_eq_preimage, e.symm.preimage_Iic, e.symm_symm]

@[simp] lemma image_Ici (e : α ≃o β) (a : α) : e '' (Ici a) = Ici (e a) :=
e.dual.image_Iic a

@[simp] lemma image_Iio (e : α ≃o β) (a : α) : e '' (Iio a) = Iio (e a) :=
by rw [e.image_eq_preimage, e.symm.preimage_Iio, e.symm_symm]

@[simp] lemma image_Ioi (e : α ≃o β) (a : α) : e '' (Ioi a) = Ioi (e a) :=
e.dual.image_Iio a

@[simp] lemma image_Ioo (e : α ≃o β) (a b : α) : e '' (Ioo a b) = Ioo (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Ioo, e.symm_symm]

@[simp] lemma image_Ioc (e : α ≃o β) (a b : α) : e '' (Ioc a b) = Ioc (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Ioc, e.symm_symm]

@[simp] lemma image_Ico (e : α ≃o β) (a b : α) : e '' (Ico a b) = Ico (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Ico, e.symm_symm]

@[simp] lemma image_Icc (e : α ≃o β) (a b : α) : e '' (Icc a b) = Icc (e a) (e b) :=
by rw [e.image_eq_preimage, e.symm.preimage_Icc, e.symm_symm]

end preorder

/-- Order isomorphism between `Iic (⊤ : α)` and `α` when `α` has a top element -/
def Iic_top [preorder α] [order_top α] : set.Iic (⊤ : α) ≃o α :=
{ map_rel_iff' := λ x y, by refl,
  .. (@equiv.subtype_univ_equiv α (set.Iic (⊤ : α)) (λ x, le_top)), }

/-- Order isomorphism between `Ici (⊥ : α)` and `α` when `α` has a bottom element -/
def Ici_bot [preorder α] [order_bot α] : set.Ici (⊥ : α) ≃o α :=
{ map_rel_iff' := λ x y, by refl,
  .. (@equiv.subtype_univ_equiv α (set.Ici (⊥ : α)) (λ x, bot_le)) }

end order_iso

/-! ### Lemmas about intervals in dense orders -/

section dense

variables (α : Type*) [preorder α] [densely_ordered α] {x y : α}

instance : no_min_order (set.Ioo x y) :=
⟨λ ⟨a, ha₁, ha₂⟩, begin
  rcases exists_between ha₁ with ⟨b, hb₁, hb₂⟩,
  exact ⟨⟨b, hb₁, hb₂.trans ha₂⟩, hb₂⟩
end⟩

instance : no_min_order (set.Ioc x y) :=
⟨λ ⟨a, ha₁, ha₂⟩, begin
  rcases exists_between ha₁ with ⟨b, hb₁, hb₂⟩,
  exact ⟨⟨b, hb₁, hb₂.le.trans ha₂⟩, hb₂⟩
end⟩

instance : no_min_order (set.Ioi x) :=
⟨λ ⟨a, ha⟩, begin
  rcases exists_between ha with ⟨b, hb₁, hb₂⟩,
  exact ⟨⟨b, hb₁⟩, hb₂⟩
end⟩

instance : no_max_order (set.Ioo x y) :=
⟨λ ⟨a, ha₁, ha₂⟩, begin
  rcases exists_between ha₂ with ⟨b, hb₁, hb₂⟩,
  exact ⟨⟨b, ha₁.trans hb₁, hb₂⟩, hb₁⟩
end⟩

instance : no_max_order (set.Ico x y) :=
⟨λ ⟨a, ha₁, ha₂⟩, begin
  rcases exists_between ha₂ with ⟨b, hb₁, hb₂⟩,
  exact ⟨⟨b, ha₁.trans hb₁.le, hb₂⟩, hb₁⟩
end⟩

instance : no_max_order (set.Iio x) :=
⟨λ ⟨a, ha⟩, begin
  rcases exists_between ha with ⟨b, hb₁, hb₂⟩,
  exact ⟨⟨b, hb₂⟩, hb₁⟩
end⟩

end dense


import tactic

/-!

# The partition challenge!

Prove that equivalence relations on α are the same as partitions of α.

Three sections:

1) partitions
2) equivalence classes
3) the challenge

## Overview

Say `α` is a type, and `R` is a binary relation on `α`.
The following things are already in Lean:

reflexive R := ∀ (x : α), R x x
symmetric R := ∀ ⦃x y : α⦄, R x y → R y x
transitive R := ∀ ⦃x y z : α⦄, R x y → R y z → R x z

equivalence R := reflexive R ∧ symmetric R ∧ transitive R

In the file below, we will define partitions of `α` and "build some
interface" (i.e. prove some propositions). We will define
equivalence classes and do the same thing.
Finally, we will prove that there's a bijection between
equivalence relations on `α` and partitions of `α`.

-/

/-

# 1) Partitions

We define a partition, and prove some easy lemmas.

-/

/-

## Definition of a partition

Let `α` be a type. A *partition* on `α` is defined to be
the following data:

1) A set C of subsets of α, called "blocks".
2) A hypothesis (i.e. a proof!) that all the blocks are non-empty.
3) A hypothesis that every term of type α is in one of the blocks.
4) A hypothesis that two blocks with non-empty intersection are equal.
-/

/-- The structure of a partition on a Type α. -/
@[ext] structure partition (α : Type) :=
(C : set (set α))
(Hnonempty : ∀ X ∈ C, (X : set α).nonempty)
(Hcover : ∀ a, ∃ X ∈ C, a ∈ X)
(Hdisjoint : ∀ X Y ∈ C, (X ∩ Y : set α).nonempty → X = Y)

-- docstrings

/-- The set of blocks. -/
add_decl_doc partition.C

/-- Every element of a block is nonempty. -/
add_decl_doc partition.Hnonempty

/-- The blocks cover the type they partition -/
add_decl_doc partition.Hcover

/-- Two blocks which share an element are equal -/
add_decl_doc partition.Hdisjoint

/-

## Basic interface for partitions

-/

namespace partition

-- let α be a type, and fix a partition P on α. Let X and Y be subsets of α.
variables {α : Type} {P : partition α} {X Y : set α}

/-- If X and Y are blocks, and a is in X and Y, then X = Y. -/
theorem eq_of_mem (hX : X ∈ P.C) (hY : Y ∈ P.C) {a : α} (haX : a ∈ X)
  (haY : a ∈ Y) : X = Y :=
-- Proof: follows immediately from the disjointness hypothesis.
P.Hdisjoint _ hX _ hY ⟨a, haX, haY⟩

/-- If a is in two blocks X and Y, and if b is in X,
  then b is in Y (as X=Y) -/
theorem mem_of_mem (hX : X ∈ P.C) (hY : Y ∈ P.C) {a b : α}
  (haX : a ∈ X) (haY : a ∈ Y) (hbX : b ∈ X) : b ∈ Y :=
begin
  sorry,
end

/-- Every term of type `α` is in one of the blocks for a partition `P`. -/
theorem mem_block (a : α) : ∃ X : set α, X ∈ P.C ∧ a ∈ X :=
begin
  sorry,
end

end partition

/-

# 2) Equivalence classes.

We define equivalence classes and prove a few basic results about them.

-/

section equivalence_classes

/-!

## Definition of equivalence classes

-/

-- Notation and variables for the equivalence class section:

-- let α be a type, and let R be a binary relation on R.
variables {α : Type} (R : α → α → Prop)

/-- The equivalence class of `a` is the set of `b` related to `a`. -/
def cl (a : α) :=
{b : α | R b a}

/-!

## Basic lemmas about equivalence classes

-/

/-- Useful for rewriting -- `b` is in the equivalence class of `a` iff
`b` is related to `a`. True by definition. -/
theorem cl_def {a b : α} : b ∈ cl R a ↔ R b a := iff.rfl

-- Assume now that R is an equivalence relation.
variables {R} (hR : equivalence R)
include hR

/-- x is in cl(x) -/
lemma mem_cl_self (a : α) :
  a ∈ cl R a :=
begin
  sorry,
end

lemma cl_sub_cl_of_mem_cl {a b : α} :
  a ∈ cl R b →
  cl R a ⊆ cl R b :=
begin
  sorry,
end

lemma cl_eq_cl_of_mem_cl {a b : α} :
  a ∈ cl R b →
  cl R a = cl R b :=
begin
  sorry
end

end equivalence_classes -- section

/-!

# 3) The challenge!

Let `α` be a type (i.e. a collection of stucff).

There is a bijection between equivalence relations on `α` and
partitions of `α`.

We prove this by writing down constructions in each direction
and proving that the constructions are two-sided inverses of one another.
-/

open partition

example (α : Type) : {R : α → α → Prop // equivalence R} ≃ partition α :=
-- We define constructions (functions!) in both directions and prove that
-- one is a two-sided inverse of the other
{ -- Here is the first construction, from equivalence
  -- relations to partitions.
  -- Let R be an equivalence relation.
  to_fun := λ R, {
    -- Let C be the set of equivalence classes for R.
    C := { B : set α | ∃ x : α, B = cl R.1 x},
    -- I claim that C is a partition. We need to check the three
    -- hypotheses for a partition (`Hnonempty`, `Hcover` and `Hdisjoint`),
    -- so we need to supply three proofs.
    Hnonempty := begin
      cases R with R hR,
      -- If X is an equivalence class then X is nonempty.
      show ∀ (X : set α), (∃ (a : α), X = cl R a) → X.nonempty,
      sorry,
    end,
    Hcover := begin
      cases R with R hR,
      -- The equivalence classes cover α
      show ∀ (a : α), ∃ (X : set α) (H : ∃ (b : α), X = cl R b), a ∈ X,
      sorry,
    end,
    Hdisjoint := begin
      cases R with R hR,
      -- If two equivalence classes overlap, they are equal.
      show ∀ (X : set α), (∃ (a : α), X = cl R a) →
        ∀ (Y : set α), (∃ (b : α), Y = cl _ b) → (X ∩ Y).nonempty → X = Y,
      sorry,
    end },
  -- Conversely, say P is an partition.
  inv_fun := λ P,
    -- Let's define a binary relation `R` thus:
    --  `R a b` iff *every* block containing `a` also contains `b`.
    -- Because only one block contains a, this will work,
    -- and it turns out to be a nice way of thinking about it.
    ⟨λ a b, ∀ X ∈ P.C, a ∈ X → b ∈ X, begin
      -- I claim this is an equivalence relation.
    split,
    { -- It's reflexive
      show ∀ (a : α)
        (X : set α), X ∈ P.C → a ∈ X → a ∈ X,
      sorry,
    },
    split,
    { -- it's symmetric
      show ∀ (a b : α),
        (∀ (X : set α), X ∈ P.C → a ∈ X → b ∈ X) →
         ∀ (X : set α), X ∈ P.C → b ∈ X → a ∈ X,
      sorry,
    },
    { -- it's transitive
      unfold transitive,
      show ∀ (a b c : α),
        (∀ (X : set α), X ∈ P.C → a ∈ X → b ∈ X) →
        (∀ (X : set α), X ∈ P.C → b ∈ X → c ∈ X) →
         ∀ (X : set α), X ∈ P.C → a ∈ X → c ∈ X,
      sorry,
    }
  end⟩,
  -- If you start with the equivalence relation, and then make the partition
  -- and a new equivalence relation, you get back to where you started.
  left_inv := begin
    rintro ⟨R, hR⟩,
    -- Tidying up the mess...
    suffices : (λ (a b : α), ∀ (c : α), a ∈ cl R c → b ∈ cl R c) = R,
      simpa,
    -- ... you have to prove two binary relations are equal.
    ext a b,
    -- so you have to prove an if and only if.
    show (∀ (c : α), a ∈ cl R c → b ∈ cl R c) ↔ R a b,
    sorry,
  end,
  -- Similarly, if you start with the partition, and then make the
  -- equivalence relation, and then construct the corresponding partition
  -- into equivalence classes, you have the same partition you started with.
  right_inv := begin
    -- Let P be a partition
    intro P,
    -- It suffices to prove that a subset X is in the original partition
    -- if and only if it's in the one made from the equivalence relation.
    ext X,
    show (∃ (a : α), X = cl _ a) ↔ X ∈ P.C,
    dsimp only,
    sorry,
  end }

/-
-- get these files with

leanproject get ImperialCollegeLondon/M40001_lean

-/


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.finset_ops
import data.multiset.fold

/-!
# Lattice operations on multisets

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

namespace multiset
variables {α : Type*}

/-! ### sup -/
section sup
-- can be defined with just `[has_bot α]` where some lemmas hold without requiring `[order_bot α]`
variables [semilattice_sup α] [order_bot α]

/-- Supremum of a multiset: `sup {a, b, c} = a ⊔ b ⊔ c` -/
def sup (s : multiset α) : α := s.fold (⊔) ⊥

@[simp] lemma sup_coe (l : list α) : sup (l : multiset α) = l.foldr (⊔) ⊥ := rfl

@[simp] lemma sup_zero : (0 : multiset α).sup = ⊥ :=
fold_zero _ _

@[simp] lemma sup_cons (a : α) (s : multiset α) :
  (a ::ₘ s).sup = a ⊔ s.sup :=
fold_cons_left _ _ _ _

@[simp] lemma sup_singleton {a : α} : ({a} : multiset α).sup = a :=
sup_bot_eq

@[simp] lemma sup_add (s₁ s₂ : multiset α) : (s₁ + s₂).sup = s₁.sup ⊔ s₂.sup :=
eq.trans (by simp [sup]) (fold_add _ _ _ _ _)

lemma sup_le {s : multiset α} {a : α} : s.sup ≤ a ↔ (∀b ∈ s, b ≤ a) :=
multiset.induction_on s (by simp)
  (by simp [or_imp_distrib, forall_and_distrib] {contextual := tt})

lemma le_sup {s : multiset α} {a : α} (h : a ∈ s) : a ≤ s.sup :=
sup_le.1 le_rfl _ h

lemma sup_mono {s₁ s₂ : multiset α} (h : s₁ ⊆ s₂) : s₁.sup ≤ s₂.sup :=
sup_le.2 $ assume b hb, le_sup (h hb)

variables [decidable_eq α]

@[simp] lemma sup_dedup (s : multiset α) : (dedup s).sup = s.sup :=
fold_dedup_idem _ _ _

@[simp] lemma sup_ndunion (s₁ s₂ : multiset α) :
  (ndunion s₁ s₂).sup = s₁.sup ⊔ s₂.sup :=
by rw [← sup_dedup, dedup_ext.2, sup_dedup, sup_add]; simp

@[simp] lemma sup_union (s₁ s₂ : multiset α) :
  (s₁ ∪ s₂).sup = s₁.sup ⊔ s₂.sup :=
by rw [← sup_dedup, dedup_ext.2, sup_dedup, sup_add]; simp

@[simp] lemma sup_ndinsert (a : α) (s : multiset α) :
  (ndinsert a s).sup = a ⊔ s.sup :=
by rw [← sup_dedup, dedup_ext.2, sup_dedup, sup_cons]; simp

lemma nodup_sup_iff {α : Type*} [decidable_eq α] {m : multiset (multiset α) } :
  m.sup.nodup ↔ ∀ (a : multiset α), a ∈ m → a.nodup :=
begin
  apply m.induction_on,
  { simp },
  { intros a s h,
    simp [h] }
end

end sup

/-! ### inf -/
section inf
-- can be defined with just `[has_top α]` where some lemmas hold without requiring `[order_top α]`
variables [semilattice_inf α] [order_top α]

/-- Infimum of a multiset: `inf {a, b, c} = a ⊓ b ⊓ c` -/
def inf (s : multiset α) : α := s.fold (⊓) ⊤

@[simp] lemma inf_coe (l : list α) : inf (l : multiset α) = l.foldr (⊓) ⊤ := rfl

@[simp] lemma inf_zero : (0 : multiset α).inf = ⊤ :=
fold_zero _ _

@[simp]

@[simp] lemma inf_singleton {a : α} : ({a} : multiset α).inf = a :=
inf_top_eq

@[simp] lemma inf_add (s₁ s₂ : multiset α) : (s₁ + s₂).inf = s₁.inf ⊓ s₂.inf :=
eq.trans (by simp [inf]) (fold_add _ _ _ _ _)

lemma le_inf {s : multiset α} {a : α} : a ≤ s.inf ↔ (∀b ∈ s, a ≤ b) :=
multiset.induction_on s (by simp)
  (by simp [or_imp_distrib, forall_and_distrib] {contextual := tt})

lemma inf_le {s : multiset α} {a : α} (h : a ∈ s) : s.inf ≤ a :=
le_inf.1 le_rfl _ h

lemma inf_mono {s₁ s₂ : multiset α} (h : s₁ ⊆ s₂) : s₂.inf ≤ s₁.inf :=
le_inf.2 $ assume b hb, inf_le (h hb)

variables [decidable_eq α]

@[simp] lemma inf_dedup (s : multiset α) : (dedup s).inf = s.inf :=
fold_dedup_idem _ _ _

@[simp] lemma inf_ndunion (s₁ s₂ : multiset α) :
  (ndunion s₁ s₂).inf = s₁.inf ⊓ s₂.inf :=
by rw [← inf_dedup, dedup_ext.2, inf_dedup, inf_add]; simp

@[simp] lemma inf_union (s₁ s₂ : multiset α) :
  (s₁ ∪ s₂).inf = s₁.inf ⊓ s₂.inf :=
by rw [← inf_dedup, dedup_ext.2, inf_dedup, inf_add]; simp

@[simp] lemma inf_ndinsert (a : α) (s : multiset α) :
  (ndinsert a s).inf = a ⊓ s.inf :=
by rw [← inf_dedup, dedup_ext.2, inf_dedup, inf_cons]; simp

end inf

end multiset


theorem T2 (a b c d : ℕ) (h1 : a = b) (h2 : b ≤ c) (h3 : c + 1 < d) : a < d :=
  calc
    a     = b     : h1
      ... < b + 1 : nat.lt_succ_self b
      ... ≤ c + 1 : nat.succ_le_succ h2
      ... < d     : h3


import mynat.mul -- hide
namespace mynat -- hide

/-
# Tutorial world

## level 2: The rewrite (`rw`) tactic.

The rewrite tactic is the way to "substitute in" the value
of a variable. In general, if you have a hypothesis of the form `A = B`, and your
goal mentions the left hand side `A` somewhere, then
the `rewrite` tactic will replace the `A` in your goal with a `B`.
Below is a theorem which cannot be
proved using `refl` -- you need a rewrite first.

Delete the sorry and take a look in the top right box at what we have.
The variables $x$ and $y$ are natural numbers, and we have
a proof `h` that $y = x + 7$. Our goal
is to prove that $2y=2(x+7)$. This goal is obvious -- we just
substitute in $y = x+7$ and we're done. In Lean, we do
this substitution using the `rw` tactic. So start your proof with

`rw h,`

and then hit enter. **Don't forget the comma.**
Did you see what happened to the goal? The goal doesn't close,
but it *changes* from `⊢ 2 * y = 2 * (x + 7)` to `⊢ 2 * (x + 7) = 2 * (x + 7)`.
We can just close this goal with

`refl,`

by writing it on the line after `rw h,`. Don't forget the comma, hit
enter, and enjoy seeing the "Proof complete!" message in the
top right window. The other reason you'll know you're
done is that the bottom right window (the error window)
becomes empty. When you've finished reading the comments below
the proof, click "Next Level" in the top right to proceed to the next
level in this world.

-/

/- Lemma : no-side-bar
If $x$ and $y$ are natural numbers,
and $y=x+7$, then $2y=2(x+7)$.
-/
lemma example2 (x y : mynat) (h : y = x + 7) : 2 * y = 2 * (x + 7) :=
begin [nat_num_game]
  rw h,
  refl

end

/- Tactic : rw

## Summary

If `h` is a proof of `X = Y`, then `rw h,` will change
all `X`s in the goal to `Y`s. Variants: `rw ← h` (changes
`Y` to `X`) and
`rw h at h2` (changes `X` to `Y` in hypothesis `h2` instead
of the goal).

## Details

The `rw` tactic is a way to do "substituting in". There
are two distinct situations where use this tactics.

1) If `h : A = B` is a hypothesis (i.e., a proof of `A = B`)
in your local context (the box in the top right)
and if your goal contains one or more `A`s, then `rw h`
will change them all to `B`'s.

2) The `rw` tactic will also work with proofs of theorems
which are equalities (look for them in the drop down
menu on the left, within Theorem Statements).
For example, in world 1 level 4
we learn about `add_zero x : x + 0 = x`, and `rw add_zero`
will change `x + 0` into `x` in your goal (or fail with
an error if Lean cannot find `x + 0` in the goal).

Important note: if `h` is not a proof of the form `A = B`
or `A ↔ B` (for example if `h` is a function, an implication,
or perhaps even a proposition itself rather than its proof),
then `rw` is not the tactic you want to use. For example,
`rw (P = Q)` is never correct: `P = Q` is the true-false
statement itself, not the proof.
If `h : P = Q` is its proof, then `rw h` will work.

Pro tip 1: If `h : A = B` and you want to change
`B`s to `A`s instead, try `rw ←h` (get the arrow with `\l` and
note that this is a small letter L, not a number 1).

### Example:
If it looks like this in the top right hand box:
```
x y : mynat
h : x = y + y
⊢ succ (x + 0) = succ (y + y)
```

then

`rw add_zero,`

will change the goal into `⊢ succ x = succ (y + y)`, and then

`rw h,`

will change the goal into `⊢ succ (y + y) = succ (y + y)`, which
can be solved with `refl,`.

### Example:
You can use `rw` to change a hypothesis as well.
For example, if your local context looks like this:
```
x y : mynat
h1 : x = y + 3
h2 : 2 * y = x
⊢ y = 3
```
then `rw h1 at h2` will turn `h2` into `h2 : 2 * y = y + 3`.
-/

/-

## Exploring your proof.

Click on `refl,` and then use the arrow keys to move
your cursor around the proof. Go up and down and note that
the goal changes -- indeed you can inspect Lean's "state" at each
line of the proof (the hypotheses, and the goal).
Try to figure out the exact place where the goal changes.
The comma tells Lean "I've finished writing this tactic now,
please process it." Lean ignores newlines, but pays great
attention to commas.

## The tactic index

The documentation for `rw` just appeared in the list of tactics
in the box on the left. Play around with the menus on the left
and see what is there currently. More information will appear as you progress.

## Bewildered?

Doesn't work? Weird error that won't go away? You can check out
the
solutions (github.com, opens in new window).
  Solutions to every level are here.
-/

end mynat -- hide


universe u

def f1 (n m : Nat) (x : Fin n) (h : n = m) : Fin m :=
h ▸ x

def f2 (n m : Nat) (x : Fin n) (h : m = n) : Fin m :=
h ▸ x

theorem ex1 {α : Sort u} {a b c : α} (h₁ : a = b) (h₂ : b = c) : a = c :=
h₂ ▸ h₁

theorem ex2 {α : Sort u} {a b : α} (h : a = b) : b = a :=
h ▸ rfl

theorem ex3 {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : r a b) (h₂ : b = c) : r a c :=
h₂ ▸ h₁

theorem ex3b {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : r a b) (h₂ : b = c) : r a c :=
h₂.symm ▸ h₁

theorem ex3c {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : r a b) (h₂ : b = c) : r a c :=
h₂.symm.symm ▸ h₁

theorem ex4 {α : Sort u} {a b c : α} (r : α → α → Prop) (h₁ : a = b) (h₂ : r b c) : r a c :=
h₁ ▸ h₂

theorem ex5 {p : Prop} (h : p = True) : p :=
h ▸ trivial

theorem ex6 {p : Prop} (h : p = False) : ¬p :=
fun hp => h ▸ hp

theorem ex7 {α} {a b c d : α} (h₁ : a = c) (h₂ : b = d) (h₃ : c ≠ d) : a ≠ b :=
h₁ ▸ h₂ ▸ h₃

theorem ex8 (n m k : Nat) (h : Nat.succ n + m = Nat.succ n + k) : Nat.succ (n + m) = Nat.succ (n + k) :=
Nat.succ_add .. ▸ Nat.succ_add .. ▸ h

theorem ex9 (a b : Nat) (h₁ : a = a + b) (h₂ : a = b) : a = b + a  :=
h₂ ▸ h₁

theorem ex10 (a b : Nat) (h : a = b) : b = a :=
h ▸ rfl

def ex11  {α : Type u} {n : Nat} (a : Array α) (i : Nat) (h₁ : a.size = n) (h₂ : i < n) : α :=
  a.get ⟨i, h₁ ▸ h₂⟩

theorem ex12 {α : Type u} {n : Nat}
  (a b : Array α)
  (hsz₁ : a.size = n) (hsz₂ : b.size = n)
  (h : ∀ (i : Nat) (hi : i < n), a.getLit i hsz₁ hi = b.getLit i hsz₂ hi) : a = b :=
Array.ext a b (hsz₁.trans hsz₂.symm) fun i hi₁ hi₂ => h i (hsz₁ ▸ hi₁)

def toArrayLit {α : Type u} (a : Array α) (n : Nat) (hsz : a.size = n) : Array α :=
List.toArray $ Array.toListLitAux a n hsz n (hsz ▸ Nat.leRefl _) []

partial def isEqvAux {α} (a b : Array α) (hsz : a.size = b.size) (p : α → α → Bool) (i : Nat) : Bool :=
  if h : i < a.size then
     let aidx : Fin a.size := ⟨i, h⟩
     let bidx : Fin b.size := ⟨i, hsz ▸ h⟩
     match p (a.get aidx) (b.get bidx) with
     | true  => isEqvAux a b hsz p (i+1)
     | false => false
  else
    true


-- import SciLean.Core.AdjDiff
import SciLean.Core.Defs
import SciLean.Core.Attributes

namespace SciLean.AutoDiffSimp

-- Additional simp lemmas for automatic/symbolic differentiation

attribute [diff_simp] mul_one one_mul zero_add add_zero

attribute [diff_simp] fun_zero_eval fun_one_eval fun_neg_eval fun_add_eval fun_sub_eval fun_mul_eval fun_div_eval fun_hmul_eval

section VecSimps
variable {X} [Vec X]
@[simp,diff_simp] theorem one_smul (x : X) : (1 : ℝ) • x = x := sorry_proof
@[simp,diff_simp] theorem zero_smul (x : X) : (0 : ℝ) • x = (0 : X) := sorry_proof
@[simp,diff_simp] theorem smul_zero (r : ℝ) : r • (0 : X) = (0 : X) := sorry_proof
@[simp,diff_simp] theorem neg_one_smul (x : X) : (-1 : ℝ) • x = -x := sorry_proof

@[simp,diff_simp] theorem add_neg_sub (x y : X) : x + -y = x - y := sorry_proof
@[simp,diff_simp] theorem neg_add_sub (x y : X) : -x + y = y - x := sorry_proof

@[simp,diff_simp] theorem smul_smul_mul (r s: ℝ) (x : X) : r • (s • x) = ((r * s) • x) := sorry_proof

@[simp,diff_simp] theorem add_same_1 (a b : ℝ) (x : X) : a•x + b•x = (a+b)•x := sorry_proof
@[simp,diff_simp] theorem add_same_2 (a : ℝ) (x : X) : a•x + x = (a+1)•x := sorry_proof
@[simp,diff_simp] theorem add_same_3 (a : ℝ) (x : X) : x + a•x = (1+a)•x := sorry_proof
@[simp,diff_simp] theorem add_same_4 (x : X) : x + x = (2:ℝ)•x := sorry_proof

@[simp,diff_simp] theorem inner_real (x y : ℝ) : ⟪x,y⟫ = x*y := by rfl; done

end VecSimps

instance : Fact ((1:ℝ) ≠ 0) := sorry_proof
instance : Fact ((2:ℝ) ≠ 0) := sorry_proof
instance : Fact ((3:ℝ) ≠ 0) := sorry_proof

@[simp, diff_simp]
theorem mul_val_recip (x y : ℝ) [Fact (x≠0)] : x * (y/x) = y := sorry_proof

@[simp, diff_simp]
theorem mul_val_recip_alt (x y z : ℝ) [Fact (x≠0)] : x * (y/(x*z)) = y/z := sorry_proof

@[simp, diff_simp]
theorem mul_recip_val (x y : ℝ) [Fact (x≠0)]: (y/x) * x = 1 := sorry_proof

@[simp, diff_simp]
theorem mul_recip_val_alt (x y z : ℝ) [Fact (x≠0)]: (y/(x*z)) * x = y/z := sorry_proof


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import linear_algebra.matrix.adjugate
import ring_theory.matrix_algebra
import ring_theory.polynomial_algebra
import tactic.apply_fun
import tactic.squeeze

/-!
# Characteristic polynomials and the Cayley-Hamilton theorem

We define characteristic polynomials of matrices and
prove the Cayley–Hamilton theorem over arbitrary commutative rings.

See the file `matrix/charpoly/coeff` for corollaries of this theorem.

## Main definitions

* `matrix.charpoly` is the characteristic polynomial of a matrix.

## Implementation details

We follow a nice proof from http://drorbn.net/AcademicPensieve/2015-12/CayleyHamilton.pdf
-/

noncomputable theory

universes u v w

open polynomial matrix
open_locale big_operators polynomial

variables {R : Type u} [comm_ring R]
variables {n : Type w} [decidable_eq n] [fintype n]

open finset

/--
The "characteristic matrix" of `M : matrix n n R` is the matrix of polynomials $t I - M$.
The determinant of this matrix is the characteristic polynomial.
-/
def charmatrix (M : matrix n n R) : matrix n n R[X] :=
matrix.scalar n (X : R[X]) - (C : R →+* R[X]).map_matrix M

@[simp] lemma charmatrix_apply_eq (M : matrix n n R) (i : n) :
  charmatrix M i i = (X : R[X]) - C (M i i) :=
by simp only [charmatrix, sub_left_inj, pi.sub_apply, scalar_apply_eq,
  ring_hom.map_matrix_apply, map_apply, dmatrix.sub_apply]

@[simp] lemma charmatrix_apply_ne (M : matrix n n R) (i j : n) (h : i ≠ j) :
  charmatrix M i j = - C (M i j) :=
by simp only [charmatrix, pi.sub_apply, scalar_apply_ne _ _ _ h, zero_sub,
  ring_hom.map_matrix_apply, map_apply, dmatrix.sub_apply]

lemma mat_poly_equiv_charmatrix (M : matrix n n R) :
  mat_poly_equiv (charmatrix M) = X - C M :=
begin
  ext k i j,
  simp only [mat_poly_equiv_coeff_apply, coeff_sub, pi.sub_apply],
  by_cases h : i = j,
  { subst h, rw [charmatrix_apply_eq, coeff_sub],
    simp only [coeff_X, coeff_C],
    split_ifs; simp, },
  { rw [charmatrix_apply_ne _ _ _ h, coeff_X, coeff_neg, coeff_C, coeff_C],
    split_ifs; simp [h], }
end

lemma charmatrix_reindex {m : Type v} [decidable_eq m] [fintype m] (e : n ≃ m)
  (M : matrix n n R) : charmatrix (reindex e e M) = reindex e e (charmatrix M) :=
begin
  ext i j x,
  by_cases h : i = j,
  all_goals { simp [h] }
end

/--
The characteristic polynomial of a matrix `M` is given by $\det (t I - M)$.
-/
def matrix.charpoly (M : matrix n n R) : R[X] :=
(charmatrix M).det

lemma matrix.charpoly_reindex {m : Type v} [decidable_eq m] [fintype m] (e : n ≃ m)
  (M : matrix n n R) : (reindex e e M).charpoly = M.charpoly :=
begin
  unfold matrix.charpoly,
  rw [charmatrix_reindex, matrix.det_reindex_self]
end

/--
The **Cayley-Hamilton Theorem**, that the characteristic polynomial of a matrix,
applied to the matrix itself, is zero.

This holds over any commutative ring.

See `linear_map.aeval_self_charpoly` for the equivalent statement about endomorphisms.
-/
-- This proof follows http://drorbn.net/AcademicPensieve/2015-12/CayleyHamilton.pdf
theorem matrix.aeval_self_charpoly (M : matrix n n R) :
  aeval M M.charpoly = 0 :=
begin
  -- We begin with the fact $χ_M(t) I = adjugate (t I - M) * (t I - M)$,
  -- as an identity in `matrix n n R[X]`.
  have h : M.charpoly • (1 : matrix n n R[X]) =
    adjugate (charmatrix M) * (charmatrix M) :=
    (adjugate_mul _).symm,
  -- Using the algebra isomorphism `matrix n n R[X] ≃ₐ[R] polynomial (matrix n n R)`,
  -- we have the same identity in `polynomial (matrix n n R)`.
  apply_fun mat_poly_equiv at h,
  simp only [mat_poly_equiv.map_mul,
    mat_poly_equiv_charmatrix] at h,
  -- Because the coefficient ring `matrix n n R` is non-commutative,
  -- evaluation at `M` is not multiplicative.
  -- However, any polynomial which is a product of the form $N * (t I - M)$
  -- is sent to zero, because the evaluation function puts the polynomial variable
  -- to the right of any coefficients, so everything telescopes.
  apply_fun (λ p, p.eval M) at h,
  rw eval_mul_X_sub_C at h,
  -- Now $χ_M (t) I$, when thought of as a polynomial of matrices
  -- and evaluated at some `N` is exactly $χ_M (N)$.
  rw [mat_poly_equiv_smul_one, eval_map] at h,
  -- Thus we have $χ_M(M) = 0$, which is the desired result.
  exact h,
end


import MyNat.Definition
namespace MyNat
open MyNat

/-!
# Function World

## Level 7: `(P → Q) → ((Q → F) → (P → F))`

Have you noticed that, in stark contrast to earlier worlds,
we are not amassing a large collection of useful theorems?
We really are just constructing abstract levels with sets and
functions, and then solving them and never using the results
ever again. Here's another one, which should hopefully be
very easy for you now. Advanced mathematician viewers will
know it as contravariance of \\(\operatorname{Hom}(\cdot,F)\\)
functor.

## Definition

Whatever the sets  `P ` and  `Q ` and  `F ` are, we
make an element of \\(\operatorname{Hom}(\operatorname{Hom}(P,Q),
\operatorname{Hom}(\operatorname{Hom}(Q,F),\operatorname{Hom}(P,F)))\\).
-/
example (P Q F : Type) : (P → Q) → ((Q → F) → (P → F)) := by
  intros f h p
  apply h
  apply f
  exact p

/-!

Next up [Level 8](./Level8.lean.md)
-/


import algebra.field
import algebra.module

universes u v w x

--class has_scalar (F : Type u) (α : Type v) := (smul : F → α → α)

--infixr ` • `:73 := has_scalar.smul

-- modules for a ring
class vec_space (F : Type u) (α : Type v) [field F] [add_comm_group α]
extends has_scalar F α :=
(smul_add : ∀ (r : F) (x y : α), r • (x + y) = r • x + r • y)
(add_smul : ∀(r s : F) (x : α), (r + s) • x = r • x + s • x)
(mul_smul : ∀ (r s : F) (x : α), (r * s) • x = r • s • x)
(one_smul : ∀ x : α, (1 : F) • x = x)

instance set_functions (F : Type u) (S : Type v) [field F] : add_comm_group (S → F) :=
{ add := λ f g, λ x, f x + g x, -- (f + g)(x) = f(x) + g(x)
  add_assoc := λ a b c, funext (λ x, add_assoc _ _ _),
  zero := λ x, (0 : F),
  zero_add := λ a, funext (λ x, zero_add (a x)),
  add_zero := λ a, funext (λ x, add_zero (a x)),
  neg := λ a, λ x, -(a x),
  add_left_neg := λ a, funext (λ x, neg_add_self (a x)),
  add_comm := λ a b, funext (λ x, add_comm (a x) (b x))}

instance vec_space_pi (F : Type u) (S : Type v) [field F] : vec_space F (S → F) :=
{ smul := λ a, λ f, λ x, a * (f x),
  smul_add := λ a, λ f g, funext (λ x, mul_add a (f x) (g x)),
  add_smul := λ a b, λ f, funext (λ x, add_mul a b (f x)),
  mul_smul := λ a b, λ f, funext (λ x, mul_assoc a b (f x)),
  one_smul := λ f, funext (λ x, one_mul (f x))
}

lemma unique_add_id (α : Type v) [add_comm_group α] :
    ∀ x : α, (∀ b : α, x + b = b) → x = 0 :=
begin
    intros x hyp,
    specialize hyp 0,
    rw eq_comm at hyp,
    rw hyp,
    symmetry,
    exact add_zero x,
end

lemma unique_add_inv (α : Type v) [add_comm_group α] :
    ∀ x y : α, x + y = 0 → y = - x :=
begin
    intros x y hyp,
    rw ← neg_add_self x at hyp,
    rw add_comm (-x) x at hyp,
    exact add_left_cancel hyp,
end

lemma zero_smul_zero (F : Type u) (α : Type v) [field F] [add_comm_group α] [vec_space F α] :
    ∀ v : α, (0 : F) • v = 0 :=
begin
    intro v, -- 0 • v = 0 -> 0 • v + v = v -> 0 • v + 1 • v = v -> (0 + 1) • v = v -> 1 • v = v
    apply @add_right_cancel _ _ _ v,
    rw ← vec_space.one_smul v,
    rw ← vec_space.mul_smul,
    rw zero_mul,
    rw ← vec_space.add_smul,
    rw [zero_add, zero_add],
end

#check add_comm_group.neg

lemma neg_one_mul' (F : Type u) (α : Type v) [field F] [add_comm_group α] [vec_space F α] :
    ∀ v : α, ((-1) : F) • v = - v :=
begin
    intro v,
    apply @add_right_cancel _ _ _ v,
    rw ← vec_space.one_smul v,
    rw ← vec_space.mul_smul,
    rw neg_add_self,
    rw neg_one_mul,
    rw ← vec_space.add_smul,
    rw neg_add_self,
    apply zero_smul_zero,
end

lemma smul_zero_zero (F : Type u) (α : Type v) [field F] [add_comm_group α] [vec_space F α] :
    ∀ a : F, a • (0 : α) = 0 :=
begin
    intro a,
    have hyp : (0 : α) = (a • 0) + - (a • 0) := by rw add_neg_self (a • (0 : α)),
    conv_rhs {rw hyp},
    rw ← neg_one_mul' F _ (a • (0 : α)),
    rw ← vec_space.mul_smul,
    rw mul_comm,
    rw vec_space.mul_smul,
    rw ← vec_space.smul_add,
    rw neg_one_mul',
    rw add_neg_self,
end


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

This is about the ideal of nilpotent elements in a commutative ring.

It is written in a somewhat constructive style, to allow us to keep
track of nilpotence exponents:

* `is_nilpotent a` is the proposition that `a` is nilpotent.

* `as_nilpotent a` is the type of pairs `⟨n,h⟩` where `h` is a proof
   that `a ^ n = 0`.  This type is nonempty iff `a` is nilpotent.
   Note that we allow `n = 0`, but `a ^ 0 = 0` only holds if the
   whole ring is trivial.

* `w_nilradical A` is the type of triples `⟨a,⟨n,h⟩⟩`, where `h` is
  a proof that `a ^ n = 0`.  The prefix `w_` is for "witnessed".

* `nilradical A` is the ideal of nilpotent elements in `A`.  This
  is represented as a structure with
  `(nilradical A).carrier = is_nilpotent : A → Prop`.  There are
  additional fields in the structure, which contain proofs that
  this carrier contains zero and is closed under addition and
  scalar multiplication.

* Lifting this, we can introduce a zero element and addition and
  scalar multiplication operations for `w_nilradical A`.  These
  satisfy most of the usual identities except that
  `0 • ⟨a,n,h⟩ = ⟨0,n,_⟩`, and this can be different from
  `0 = ⟨0,1,_⟩`,
-/

import algebra.ring
import algebra.group_power algebra.geom_sum
import data.nat.choose
import ring_theory.ideal.basic ring_theory.ideal.quotient

universe u
variables {A : Type u} [comm_ring A]

namespace commutative_algebra

def as_nilpotent (a : A) := {n : ℕ // a ^ n = 0}

def as_nilpotent_congr {a b : A} (e : a = b)
 (ha : as_nilpotent a) : as_nilpotent b :=
  ⟨ha.val,e ▸ ha.property⟩

lemma as_nilpotent_congr_exp {a b : A} (e : a = b)
 (ha : as_nilpotent a) :
  (as_nilpotent_congr e ha).1 = ha.1 := rfl

inductive is_nilpotent (a : A) : Prop
| mk : (as_nilpotent a) → is_nilpotent

def as_nilpotent_zero : as_nilpotent (0 : A) := ⟨1,pow_one 0⟩
lemma is_nilpotent_zero : is_nilpotent (0 : A) := ⟨as_nilpotent_zero⟩

/-- The meaning of the mul_exp function is as follows:
 if x ^ n = y ^ m = 0, then (x + y) ^ (mul_exp n m) = 0.
 Usually we just have (mul_exp n m) = n + m - 1, but if
 n or m is zero then the whole ring is necessarily trivial
 and so it is natural to take mul_exp n m = 0.  With this
 definition, it works out that the mul_exp operation gives
 a commutative monoid structure on ℕ, with 1 as the identity
 element.  We prove the commutative monoid laws but we do
 not define a comm_monoid instance, to avoid interfering
 with the standard multiplicative monoid structure on ℕ.
-/

def mul_exp : ℕ → ℕ → ℕ
| 0 m := 0
| (n + 1) 0 := 0
| (n + 1) (m + 1) := n + m + 1

namespace mul_exp

lemma zero_mul (m : ℕ) : mul_exp 0 m = 0 := rfl
lemma mul_zero (n : ℕ) : mul_exp n 0 = 0 := by { cases n; refl }
lemma one_mul (m : ℕ) : mul_exp 1 m = m :=
by { cases m, refl, change 0 + m + 1 = m + 1, rw[nat.zero_add] }
lemma mul_one (n : ℕ) : mul_exp n 1 = n :=
by { cases n; refl }

lemma mul_comm (n m : ℕ) : mul_exp n m = mul_exp m n :=
 by {cases n; cases m; dsimp[mul_exp]; try {refl}, rw[add_comm n m]}

lemma mul_assoc (n m p : ℕ) :
 mul_exp (mul_exp n m) p = mul_exp n (mul_exp m p) :=
by { cases n; cases m; cases p; dsimp[mul_exp]; try {refl},
     repeat{rw[add_assoc]},}

end mul_exp

lemma nilpotent_add_aux {a b : A} {n m : ℕ}
(ea : a ^ n = 0) (eb : b ^ m = 0) : (a + b) ^ (mul_exp n m) = 0 :=
begin
  have hz : (1 : A) = 0 → (∀ (x : A), x = 0) :=
    λ h x, by { rw[← mul_one x, h, mul_zero] },
  rcases n with ⟨_|n⟩,
  { rw [pow_zero] at ea, exact hz ea _ },
  rcases m with ⟨_|m⟩,
  { rw[pow_zero] at eb, exact hz eb _ },
  have : mul_exp n.succ m.succ = n + m + 1 := rfl,
  rw [this, add_pow],
  rw[← @finset.sum_const_zero A ℕ (finset.range (n + m + 1).succ)],
  congr, ext i,
  by_cases hi : i ≥ n + 1,
  { rw[← nat.add_sub_of_le hi,pow_add,ea],
    repeat {rw[zero_mul]} },
  { replace hi := nat.le_of_lt_succ (lt_of_not_ge hi),
    have := nat.add_sub_of_le hi,
    have : n + m + 1 - i = (m + 1) + (n - i) :=
      by rw [← this, add_comm i, add_assoc, nat.add_sub_cancel,
             add_assoc, add_comm i, ← add_assoc,
             nat.add_sub_cancel, add_comm],
    rw [this, pow_add, eb, zero_mul, mul_zero, zero_mul] }
end

def as_nilpotent_add {a b : A}
 (ha : as_nilpotent a) (hb : as_nilpotent b) : as_nilpotent (a + b) :=
⟨mul_exp ha.val hb.val, nilpotent_add_aux ha.property hb.property⟩

lemma as_nilpotent_add_exp {a b : A}
(ha : as_nilpotent a) (hb : as_nilpotent b) :
(as_nilpotent_add ha hb).1 = mul_exp ha.1 hb.1 := rfl

lemma is_nilpotent_add {a b : A} :
  is_nilpotent a → is_nilpotent b → is_nilpotent (a + b) :=
λ ⟨ha⟩ ⟨hb⟩, ⟨as_nilpotent_add ha hb⟩

def as_nilpotent_smul (a : A) {b : A}
  (hb : as_nilpotent b) : as_nilpotent (a * b) :=
⟨hb.1,by { rw [mul_pow, hb.2, mul_zero] }⟩

lemma as_nilpotent_smul_exp (a : A) {b : A} (hb : as_nilpotent b) :
  (as_nilpotent_smul a hb).1 = hb.1 := rfl

lemma is_nilpotent_smul (a : A) {b : A} :
  is_nilpotent b → is_nilpotent (a * b) :=
λ ⟨hb⟩, ⟨as_nilpotent_smul a hb⟩

def as_nilpotent_neg {b : A} :
  as_nilpotent b → as_nilpotent (-b) :=
λ h, as_nilpotent_congr (neg_eq_neg_one_mul b).symm (as_nilpotent_smul (-1) h)

lemma as_nilpotent_neg_exp {a : A} (ha : as_nilpotent a) :
  (as_nilpotent_neg ha).1 = ha.1 :=
by { rw[ ← as_nilpotent_smul_exp (-1) ha],
     rw[ ← as_nilpotent_congr_exp (neg_eq_neg_one_mul a).symm (as_nilpotent_smul (-1) ha)],
     refl }

lemma is_nilpotent_neg {b : A} :
  is_nilpotent b → is_nilpotent (-b) :=
λ ⟨hb⟩, ⟨as_nilpotent_neg hb⟩

def as_nilpotent_sub {a b : A}
  (ha : as_nilpotent a) (hb : as_nilpotent b) : as_nilpotent (a - b) :=
as_nilpotent_congr (sub_eq_add_neg a b).symm (as_nilpotent_add ha (as_nilpotent_neg hb))

lemma as_nilpotent_sub_exp {a b : A}
  (ha : as_nilpotent a) (hb : as_nilpotent b) :
  (as_nilpotent_sub ha hb).1 = mul_exp ha.1 hb.1 :=
by {
  rw [← as_nilpotent_neg_exp hb, ← as_nilpotent_add_exp ha (as_nilpotent_neg hb)],
  dsimp[as_nilpotent_sub], refl
}

lemma is_nilpotent_sub {a b : A} :
  is_nilpotent a → is_nilpotent b → is_nilpotent (a - b) :=
λ ⟨ha⟩ ⟨hb⟩, ⟨as_nilpotent_sub ha hb⟩

def as_nilpotent_chain {a : A} {n : ℕ} :
  as_nilpotent (a ^ n) → as_nilpotent a
| ⟨m,ha⟩ := ⟨n * m,(pow_mul a n m).symm ▸ ha⟩

lemma is_nilpotent_chain {a : A} {n : ℕ} :
  is_nilpotent (a ^ n) → is_nilpotent a :=
λ ⟨ha⟩, ⟨as_nilpotent_chain ha⟩

variable (A)
def w_nilradical := Σ (a : A), as_nilpotent a
variable {A}

namespace w_nilradical

variables (a b c : w_nilradical A)

instance : has_coe (w_nilradical A) A := ⟨λ a, a.1⟩

def exp : ℕ := a.2.val

def prop : (a : A) ^ a.exp = 0 := a.2.property

@[ext]
lemma ext : ∀ {a b : w_nilradical A},
 (a : A) = (b : A) → a.exp = b.exp → a = b :=
begin
 rintro ⟨a,⟨n,ha⟩⟩ ⟨b,⟨m,hb⟩⟩ hv he,
 change a = b at hv, dsimp[exp] at he, rw[hv] at ha,
 cases hv,cases he,refl,
end

instance : has_zero (w_nilradical A) := ⟨⟨(0 : A),as_nilpotent_zero⟩⟩

lemma zero_coe : ((0 : w_nilradical A) : A) = 0 := rfl
lemma zero_exp : (0 : w_nilradical A).exp = 1 := rfl

instance : has_add (w_nilradical A) :=
⟨λ a b, ⟨a.1 + b.1,as_nilpotent_add a.2 b.2⟩⟩

lemma add_coe : ((a + b : w_nilradical A) : A) = a + b := rfl
lemma exp_add : (a + b).exp = mul_exp a.exp b.exp := rfl

instance : has_scalar A (w_nilradical A) :=
⟨λ a b, ⟨a * b.1,as_nilpotent_smul a b.2⟩⟩

lemma smul_coe (a : A) (b : w_nilradical A) : ((a • b) : A) = a * b := rfl
lemma exp_smul (a : A) (b : w_nilradical A) : (a • b).exp = b.exp := rfl

instance : has_neg (w_nilradical A) :=
⟨λ a, ⟨-a.1, as_nilpotent_neg a.2⟩⟩

lemma neg_coe : ((- a : w_nilradical A) : A) = - a := rfl
lemma exp_neg : (- a).exp = a.exp := rfl

instance : has_sub (w_nilradical A) :=
⟨λ a b, ⟨a.1 - b.1,as_nilpotent_sub a.2 b.2⟩⟩

lemma sub_coe : ((a - b : w_nilradical A) : A) = a - b := rfl
lemma exp_sub (a b : w_nilradical A) : (a - b).exp = mul_exp a.exp b.exp :=
 as_nilpotent_sub_exp a.2 b.2

instance : add_comm_monoid (w_nilradical A) := {
  zero := has_zero.zero,
  add := (+),
  zero_add := λ a,
   by {ext, rw[add_coe,zero_coe,zero_add],
            rw[exp_add,zero_exp,mul_exp.one_mul]},
  add_zero := λ a,
   by {ext, rw[add_coe,zero_coe,add_zero],
            rw[exp_add,zero_exp,mul_exp.mul_one]},
  add_comm := λ a b,
   by {ext, rw[add_coe,add_coe,add_comm],rw[exp_add,exp_add,mul_exp.mul_comm]},
  add_assoc := λ a b c,
   by {ext,
       {repeat {rw[add_coe]}, rw[add_assoc]},
       {repeat {rw[exp_add]}, rw[mul_exp.mul_assoc]}
      }
}

lemma smul_zero (a : A) : a • (0 : w_nilradical A) = 0 :=
 by {ext, change (a * 0 : A) = 0, exact mul_zero a,rw[exp_smul]}

lemma smul_add (a : A) (b c : w_nilradical A) : a • (b + c) = (a • b) + (a • c) :=
 by {ext,
     change (a * (b + c) : A) = a * b + a * c, apply mul_add,
     rw[exp_smul,exp_add,exp_add,exp_smul,exp_smul]}

lemma one_smul (b : w_nilradical A) : (1 : A) • b = b :=
 by {ext, change (1 * b : A) = b, apply one_mul, rw[exp_smul]}

lemma mul_smul (a b : A) (c : w_nilradical A) : (a * b) • c = a • (b • c) :=
 by {ext, change ((a * b) * c : A) = a * (b * c), apply mul_assoc,
     rw[exp_smul,exp_smul,exp_smul]}

/- Neither zero_smul or add_smul are satisfied in this context -/

end w_nilradical

variable (A)

def is_reduced: Prop := ∀ (x : A), (is_nilpotent x) → (x = 0)

def nilradical : ideal A := {
  carrier := is_nilpotent,
  zero_mem' := is_nilpotent_zero,
  add_mem' := λ _ _, is_nilpotent_add,
  smul_mem' := λ (a : A) {b : A} (hb : is_nilpotent b),is_nilpotent_smul a hb
}

lemma mem_nilradical (x : A) : x ∈ nilradical A ↔ is_nilpotent x :=
 by {refl}

def reduced_quotient := A ⧸ (nilradical A)

namespace reduced_quotient

instance : comm_ring (reduced_quotient A) :=
  by { dsimp[reduced_quotient]; apply_instance }

variable {A}

def mk : A →+* reduced_quotient A := ideal.quotient.mk (nilradical A)

lemma mk_eq_zero_iff {x : A} : mk x = 0 ↔ (is_nilpotent x) :=
 ideal.quotient.eq_zero_iff_mem

lemma is_reduced : is_reduced (reduced_quotient A) :=
begin
 rintros ⟨x0⟩ ⟨n,e0⟩,
 change (mk x0) ^ n = 0 at e0,
 rw[← (map_pow mk x0 n)] at e0,
 rcases (mk_eq_zero_iff.mp e0) with ⟨m,e1⟩,
 rw[← pow_mul] at e1,
 apply mk_eq_zero_iff.mpr,
 exact ⟨⟨n * m, e1⟩⟩,
end

end reduced_quotient

variable {A}

lemma unit_not_nilpotent (a b : A) :
 (a * b = 1) → ((1 : A) ≠ 0) →  ¬ is_nilpotent a :=
λ hab hz ⟨⟨m,ha⟩⟩,
 hz (by {rw[← _root_.one_pow m,← hab,mul_pow,ha,zero_mul]})

lemma one_sub_nilpotent_aux {a : A} {n : ℕ} (ha : a ^ n = 0) :
 (1 - a) * (geom_sum a n) = 1 :=
by rw[mul_neg_geom_sum, ha, sub_zero]

lemma unit_add_nilpotent_aux {u v a : A} {n : ℕ}
 (hu : u * v = 1) (ha : a ^ n = 0) :
  (u + a) * (v * (finset.range n).sum (λ i, (- v * a) ^ i)) = 1 :=
begin
 rw[← mul_assoc,add_mul,hu,mul_comm a v,← sub_neg_eq_add 1 (v * a),neg_mul_eq_neg_mul],
 let h₀ : (- v * a) ^ n = 0 := by {rw[mul_pow,ha,mul_zero],},
 exact one_sub_nilpotent_aux h₀,
end

def unit_add_nilpotent (u : units A) (a : w_nilradical A) : units A := {
 val := u + a,
 inv := u.inv * (finset.range a.exp).sum (λ i, (- u.inv * a) ^ i),
 val_inv := unit_add_nilpotent_aux u.val_inv a.prop,
 inv_val := (mul_comm _ _).trans (unit_add_nilpotent_aux u.val_inv a.prop)
}

lemma unit_add_nilpotent_coe (u : units A) (a : w_nilradical A) :
 (unit_add_nilpotent u a).val = u + a := rfl

end commutative_algebra


import data.set.finite data.pnat.basic tactic.ring

/-! # IMO 2013 N3, Generalized Version -/

namespace IMOSL
namespace IMO2013N3

variables {S : Type*} [linear_order S]

def good (f : ℕ+ → S) (n : ℕ+) := f (n ^ 4 + n ^ 2 + 1) = f ((n + 1) ^ 4 + (n + 1) ^ 2 + 1)

/-- Proof of the identity `(n + 1)⁴ + (n + 1)² + 1 = (n² + n + 1)((n + 1)² + (n + 1) + 1)`. -/
private lemma special_identity (n : ℕ+) :
  ((n + 1) ^ 2) ^ 2 + (n + 1) ^ 2 + 1 = (n ^ 2 + n + 1) * ((n + 1) ^ 2 + (n + 1) + 1) :=
  by apply pnat.eq; simp only [positive.coe_one, pnat.mul_coe, pnat.pow_coe, pnat.add_coe]; ring

/-- Final solution -/
theorem final_solution_general {f : ℕ+ → S} (h : ∀ a b : ℕ+, f (a * b) = max (f a) (f b)) :
  set.infinite (set_of (good f)) :=
begin
  ---- Set `g(n) = f(n^2 + n + 1)` and re-interpret in terms of `g` instead of `f`
  apply set.infinite_of_not_bdd_above; rintros ⟨N, h0⟩,
  simp_rw [upper_bounds, set.mem_set_of, good] at h0,
  let T := λ n : ℕ+, n ^ 2 + n + 1,
  replace h : ∀ n : ℕ+, (f ∘ T) ((n + 1) ^ 2) = max ((f ∘ T) n) ((f ∘ T) (n + 1)) :=
    λ n, by simp_rw [function.comp_app, T]; rw [special_identity, h],
  replace h0 : ∀ n : ℕ+, (f ∘ T) (n ^ 2) = (f ∘ T) ((n + 1) ^ 2) → n ≤ N :=
    λ n, by simp_rw [function.comp_app, T, ← pow_mul]; rw [two_mul, ← bit0]; exact @h0 n,
  generalize_hyp : f ∘ T = g at h h0,
  clear f T,

  ---- For all `n ≥ N`, `g(n) ≤ g(n + 1)` implies `g(n + 1) < g(n + 2)`
  replace h0 : ∀ n, N ≤ n → g n ≤ g (n + 1) → g (n + 1) < g (n + 1 + 1) :=
  begin
    intros n h1 h2; contrapose! h0,
    refine ⟨n + 1, _, pnat.lt_add_one_iff.mpr h1⟩,
    rw [h, max_eq_right h2, h, max_eq_left h0],
  end,

  ---- There exists `C ≥ N` such that `g(C) ≤ g(C + 1)`
  obtain ⟨C, h1, h2⟩ : ∃ C : ℕ+, N ≤ C ∧ g C ≤ g (C + 1) :=
  begin
    replace h : g (N + 1) ≤ g ((N + 1) ^ 2) :=
      by rw h; exact le_max_right (g N) (g (N + 1)),
    contrapose! h; rw [sq, mul_add_one, add_comm _ (N + 1)],
    generalize : (N + 1) * N = k,
    induction k using pnat.case_strong_induction_on with k h1,
    exact h (N + 1) (le_of_lt (N.lt_add_right 1)),
    rw ← add_assoc; refine lt_trans (h _ _) (h1 k (le_refl k)),
    rw add_assoc; exact le_of_lt (N.lt_add_right (1 + k))
  end,

  ---- Reduce to showing `g(C + 1) < g(C + 1 + k)` for all `k > 0`
  replace h := h C,
  rw [max_eq_right h2, sq, mul_add_one, add_comm _ (C + 1)] at h,
  generalize_hyp : (C + 1) * C = k at h,
  revert h; apply ne_of_gt; revert k,

  ---- Final step via two inductions
  replace h0 : ∀ k : ℕ+, g (C + k) < g (C + k + 1) :=
  begin
    intros k; induction k using pnat.case_strong_induction_on with k h3,
    exact h0 C h1 h2,
    rw ← add_assoc,
    exact h0 _ (le_trans h1 (le_of_lt (C.lt_add_right k))) (le_of_lt (h3 k (le_refl k)))
  end,

  clear h1 h2 N,
  intros k; induction k using pnat.case_strong_induction_on with k h,
  exact h0 1,
  rw ← add_assoc; refine lt_trans (h k (le_refl k)) _,
  rw add_assoc; exact h0 (1 + k)
end

end IMO2013N3
end IMOSL


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module number_theory.class_number.function_field
! leanprover-community/mathlib commit d0259b01c82eed3f50390a60404c63faf9e60b1f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.ClassNumber.AdmissibleCardPowDegree
import Mathbin.NumberTheory.ClassNumber.Finite
import Mathbin.NumberTheory.FunctionField

/-!
# Class numbers of function fields

This file defines the class number of a function field as the (finite) cardinality of
the class group of its ring of integers. It also proves some elementary results
on the class number.

## Main definitions
- `function_field.class_number`: the class number of a function field is the (finite)
cardinality of the class group of its ring of integers
-/

namespace FunctionField

open Polynomial

variable (Fq F : Type) [Field Fq] [Fintype Fq] [Field F]

variable [Algebra Fq[X] F] [Algebra (Ratfunc Fq) F]

variable [IsScalarTower Fq[X] (Ratfunc Fq) F]

variable [FunctionField Fq F] [IsSeparable (Ratfunc Fq) F]

open Classical

namespace RingOfIntegers

open FunctionField

noncomputable instance : Fintype (ClassGroup (ringOfIntegers Fq F)) :=
  ClassGroup.fintypeOfAdmissibleOfFinite (Ratfunc Fq) F
    (Polynomial.cardPowDegreeIsAdmissible :
      AbsoluteValue.IsAdmissible (Polynomial.cardPowDegree : AbsoluteValue Fq[X] ℤ))

end RingOfIntegers

/-- The class number in a function field is the (finite) cardinality of the class group. -/
noncomputable def classNumber : ℕ :=
  Fintype.card (ClassGroup (ringOfIntegers Fq F))
#align function_field.class_number FunctionField.classNumber

/-- The class number of a function field is `1` iff the ring of integers is a PID. -/
theorem classNumber_eq_one_iff :
    classNumber Fq F = 1 ↔ IsPrincipalIdealRing (ringOfIntegers Fq F) :=
  card_classGroup_eq_one_iff
#align function_field.class_number_eq_one_iff FunctionField.classNumber_eq_one_iff

end FunctionField