import .topologia
import .metrics
import data.set.finite
import data.real.basic -- for metrics

open set
open topological_space

noncomputable theory

/- Now it is quite easy to give a topology on the product of a pair of
   topological spaces. -/
instance prod.topological_space (X Y : Type) [topological_space X]
  [topological_space Y] : topological_space (X × Y) :=
topological_space.generate_from {U | ∃ (Ux : set X) (Uy : set Y)
  (hx : is_open Ux) (hy : is_open Uy), U = set.prod Ux Uy}

lemma is_open_prod (X Y : Type) [topological_space X] [topological_space Y]
 {U : set X} {V : set Y} (hU : is_open U) (hV : is_open V) : is_open (U.prod V) :=
begin
  fconstructor,
  simp,
  exact ⟨U, hU, ⟨V, ⟨hV,rfl⟩⟩⟩,
end

lemma is_open_prod_iff {X Y : Type} [topological_space X] [topological_space Y]
  {s : set (X × Y)} :
  is_open s ↔ (∀ (ab : X × Y), ab ∈ s → ∃u v, is_open u ∧ is_open v ∧
  ab.1 ∈ u ∧ ab.2 ∈ v ∧ set.prod u v ⊆ s) :=
  begin
    split,
    {
      intros h_s ab h_ab,
      induction h_s with w hw ℬ hh h₁ h₂ h₃ h₄ h₅ h₆ h₇,
      {
        let h := (univ: set X).prod (univ: set Y),
        exact ⟨univ, univ, univ_mem, univ_mem, trivial, trivial, h.subset_univ⟩,
      },
      {
        rcases hw with ⟨w_x, ⟨w_y, ⟨h_x, ⟨h_y, hh⟩⟩⟩⟩,
        use w_x,
        use w_y,
        repeat {split},
        all_goals {try {finish} },
      },
      {
        rcases h_ab with ⟨U, hU_1, hU_2⟩,
        let h1 := h₁ U hU_1 hU_2,
        norm_num at h1,
        obtain ⟨u, h_u⟩ := h1,
        cases h_u with is_open_u h_uv,
        obtain ⟨v, h_v⟩ := h_uv,
        use u, use v,
        repeat {split},
        all_goals {try {tauto}},
        intros a ha,
        use U,
        tauto,
      },
      {
        cases h_ab,
        have h1 : ∃ (u : set X) (v : set Y), is_open u ∧ is_open v ∧ ab.1 ∈ u ∧ ab.2 ∈ v ∧ u.prod v ⊆ h₂,
        {
          apply h₆,
          tauto,
        },
        have h2 : ∃ (u : set X) (v : set Y), is_open u ∧ is_open v ∧ ab.1 ∈ u ∧ ab.2 ∈ v ∧ u.prod v ⊆ h₃,
        {
          apply h₇,
          tauto,
        },
        rcases h1 with ⟨x1, y1, is_open_x1, is_open_y1, a_in_x1, b_in_y1, prod_in_h2⟩,
        rcases h2 with ⟨x2, y2, is_open_x2, is_open_y2, a_in_x2, b_in_y2, prod_in_h3⟩,
        use x1 ∩ x2,
        use y1 ∩ y2,
        repeat {split},
        all_goals {
          try {apply topological_space.inter},
          try {tauto},
          try {assumption},
        },
        intros xy h_xy,
        have h1: (x1 ∩ x2).prod (y1 ∩ y2) ⊆ x1.prod y1,
          by simp [←prod_inter_prod],
        have h2: (x1 ∩ x2).prod (y1 ∩ y2) ⊆ x2.prod y2,
          by simp [←prod_inter_prod],
        split;
        tauto,
      }
    },
    {
      intro h,
     let Opens : set (set (X × Y)):=
       { uv | ∃ (u: set X) (v : set Y), uv = (set.prod u v) ∧ is_open u ∧ is_open v ∧ (set.prod u v) ⊆ s},
     have h_s : s = ⋃₀ Opens,
     begin
       ext1,
       split,
       {
         cases x with x y,
         intro h_xy,
         norm_num,
         have hh := h (x, y) h_xy,
         obtain ⟨u, v, is_open_u, is_open_v, x_in_u, y_in_v, uv_in_s⟩ := hh,
         use set.prod u v,
         use u,
         use v,
         tauto,
         finish,
    },
       {
         intro h_Opens,
         obtain ⟨U, ⟨x, y, U_eq_xy, is_open_x, is_open_y, xy_subset_s⟩, x_in_U⟩ := h_Opens,
         apply xy_subset_s,
         finish,
       }
     end,
     rw h_s,
     apply topological_space.union,
     intros B hB,
     simp at *,
     obtain ⟨x, y, B_is_xy, is_open_x, is_open_y, h_xy⟩ := hB,
     fconstructor,
     norm_num,
     use x,
     split,
     exact is_open_x,
     use y,
     split; assumption,
    },
  end

namespace metric_space
open metric_space_basic

lemma is_open_prod_balls {X Y : Type} (r : ℝ) [metric_space X] [metric_space Y]
  (xy : X × Y) : is_open {zt : X × Y | dist xy.1 zt.1 < r ∧
  dist xy.2 zt.2 < r} :=
begin
  change is_open ({x : X | dist xy.1 x < r}.prod
  {y : Y | dist xy.2 y < r}),
  apply is_open_prod;
  apply open_of_ball,
end

/- Now lets define the product of two metric spaces properly -/
instance {X Y : Type} [metric_space X] [metric_space Y] : metric_space (X × Y) :=
{ compatible :=
  begin
    intro U,
    split,
    {
      intros hU xy hxy,
      have H := is_open_prod_iff.1 hU xy hxy,
      obtain ⟨u, v, ⟨hu, hv, hxyu, hxyv, huvU⟩⟩ := H,
      have hu' : ∃ ru, (0 < ru) ∧ (ball xy.fst ru ⊆ u)
        := (compatible u).mp hu xy.fst hxyu,
      have hv' : ∃ rv, (0 < rv) ∧ ball xy.snd rv ⊆ v
        := (compatible v).mp hv xy.snd hxyv,
      obtain ⟨ru, ⟨hru, hu'⟩⟩ := hu',
      obtain ⟨rv, ⟨hrv, hv'⟩⟩ := hv',
      use min ru rv,
      split,
      { exact lt_min hru hrv },
      have hu'': ball xy.fst (min ru rv) ⊆ u
        := subset.trans (ball_subset_ball (min_le_left ru rv)) hu',
      have hv'': ball xy.snd (min ru rv) ⊆ v
        := subset.trans (ball_subset_ball (min_le_right ru rv)) hv',
      apply subset.trans _ huvU,
      have H' : {zt : X × Y | dist xy zt < min ru rv} =
        {z : X | dist xy.fst z < min ru rv}.prod {t : Y | dist xy.snd t < min ru rv},
      {
        unfold dist,
        ext,
        simp,
        tauto,
      },
      rw H',
      rw prod_subset_prod_iff, left,
      split; assumption,
    },
    {
      intros h,
      rw is_open_prod_iff,
      intros ab hab,
      specialize h ab hab,
      obtain ⟨r, hr, hrU⟩ := h,
      use (ball ab.fst r),
      use (ball ab.snd r),
      repeat {split},
      { exact open_of_ball },
      { exact open_of_ball },
      { exact mem_center_ball_iff.mpr hr },
      { exact mem_center_ball_iff.mpr hr },
      simp [hrU],
    }
  end,
  ..prod.topological_space X Y,
  ..prod.metric_space_basic X Y
}

end metric_space


import tutorial_world.level12_cases3_exists --hide
open IncidencePlane --hide
open set --hide

/- Tactic : left and right
## Summary
`left` and `right` work on the goal, and they change
`⊢ P ∨ Q` to `⊢ P` and `⊢ Q` respectively.
## Details
The tactics `left` and `right` work on a goal which is a type with
two constructors, the classic example being `P ∨ Q`.
To prove `P ∨ Q` it suffices to either prove `P` or prove `Q`,
and once you know which one you are going for you can change
the goal with `left` or `right` to the appropriate choice.
-/

/- Tactic : unfold
## Summary
`unfold` works both on the goal and the hypotheses. It transforms some
mathematical expressions into others which are simpler to read.
## Example
If we find the expression `⊢ collinear {A, B, C}`, then typing `unfold collinear`
will change the goal into `⊢ ∃ (ℓ : Line Ω), ∀ {P : Ω}, P ∈ {A, B, C} → P ∈ ℓ`, which makes
it easier to understand what `tactic` we should apply to solve the goal.
-/

/-
# Tutorial World

## Level 13: the `unfold`, and the `left` and `right` tactics.

Until now, we have seen how to
prove a goal of the form `P ∧ Q` with the `split` tactic. In this level, you will learn how to prove a goal of the
form `P ∨ Q`, which means that either `P` holds or `Q` holds. In this case, you will have to decide whether you can
prove `P` or `Q`. The `left` and `right` tactics will allow you to change the goal to `⊢ P` or `⊢ Q`, respectively.

[**Tip:** Before typing any line, try to think which is the shortest path to finish the proof, either P or Q.] To
take the best decision, read the lemma and do a drawing of the situation. Once you're done, come back here. In this
case, it seems clear that proving `⊢ A = C` is not possible, since we don't have any hypotheses we can use to make progress.
In case you are not sure about that, try to prove `⊢ A = C` by typing `left,` and you will see that is not possible to move on from there.
Because of this reason, changing the goal into `⊢ collinear {A, B, C}` by typing `right,` will be the right path to complete this level.
[**Remember:** In geometry, collinearity is the property of a set of points lying on the same line. In Lean, the elements of a set are
written between curly brackets, separated by commas {A, B, C}.]

Now, you may be wondering how we could step through `⊢ collinear {A, B, C}` if there isn't any `tactic` that works with this form
of goal. To your surprise, there exists a tactic called `unfold` whose purpose is transforming some mathematical expressions into
others which are simpler to read. Type `unfold collinear,` to see how the goal changes into `⊢ ∃ (ℓ : Line Ω), ∀ {P : Ω}, P ∈ {A, B, C} → P ∈ ℓ`.
This last goal is read as **there exists a line ℓ in the plane Ω "for all" (∀) points P in the plane Ω, such that P being an element of the set of points
A, B and C implies that P is an element of the line ℓ.**

I'm sure that you know now what tactic makes progress with this type of goal. To give you a hint, we need to consider a specific line ℓ in the plane Ω.
Can you see that the hypothesis `h` assumes that the point C is an element of the `line_through A B`? Then, because the goal says that the point P is an
element of the set of points A, B and C, there is no other way than changing the line ℓ into the `line_through A B`. Once you've done that, use the `intros`
tactic to add two new hypotheses to the local context until you see the goal `⊢ P ∈ line_through A B`. From there, use the `cases` tactic to make the point P
equal to the points A, B and C, in each of the cases. Try to finish the proof by your own. In case you get stuck, I recommend you to take a look at the previous levels.

-/

/- Hint : Click here for a hint, in case you get stuck.
After typing `unfold collinear,`, you should have noticed that the `use` tactic had to be employed with `line_through A B`. Then,
you made progress by typing `intros P hP,`. Now, use `cases hP` and make an effort to prove the goals that you are left with. The
`exact` and `rewrite` tactics may help you. Bewildered? Click on "View source" (located on the top right corner of the game screen) to see the solution.
-/
variables {Ω : Type} [IncidencePlane Ω] -- hide

/- Lemma : no-side-bar
Given three distinct points A, B and C, if C lies in the line through A and B, either A = C or A, B and C are collinear points.
-/
lemma left_right_example (A B C : Ω) (h : C ∈ line_through A B) :
A = C ∨ collinear ({A, B, C} : set Ω) :=
begin
  right,
  unfold collinear,
  use line_through A B,
  intros P hP,
  cases hP,
  {
    rw hP,
    exact line_through_left A B,
  },
  cases hP,
  {
    rw hP,
    exact line_through_right A B,
  },
  {
    cases hP,
    exact h,
  },

end


import tactic
import order.zorn

variable {α : Type*}

lemma max_of_fin_chain [partial_order α]
: ∀{c : set α}, c.finite → is_chain (≤) c → c.nonempty → ∃m ∈ c, ∀{b}, b ∈ c → b ≤ m :=
begin
	intros c c_fin c_chain c_nonempty,
	rcases finset.exists_maximal (set.finite.to_finset c_fin)
	((set.finite.nonempty_to_finset c_fin).mpr c_nonempty) with ⟨m, hmc, hm⟩,
	have hmc' :=(set.finite.mem_to_finset c_fin).mp hmc,
	use [m, hmc'],
	intros b hbc,
	specialize hm b ((set.finite.mem_to_finset c_fin).mpr hbc),
	unfold is_chain set.pairwise at c_chain,
	specialize c_chain hbc hmc',
	by_cases hbm : b = m,
	{exact (eq.symm hbm).ge},
	{
		cases c_chain hbm, exact h, exfalso,
		exact hm ((ne.symm hbm).lt_of_le h),
	}
end

def finite_character (F : set (set α)) : Prop :=
∀ X, X ∈ F ↔ (∀ {Y : set α}, Y ⊆ X → Y.finite → Y ∈ F)

variable {F : set (set α)}

lemma mem_empty_of_fin_character :
F.nonempty → finite_character F → ∅ ∈ F :=
begin
	intros F_nonempty F_fin_char,
	cases F_nonempty with X hX,
	exact (F_fin_char X).mp hX (set.empty_subset X) set.finite_empty,
end

lemma exists_maximal_of_finite_character {X} (hX : X ∈ F) :
 finite_character F → ∃M ∈ F, X ⊆ M ∧ ∀{Y}, Y ∈ F → M ⊆ Y → Y = M :=
begin
	intro F_fin_char,
	apply zorn_subset_nonempty, swap, exact hX,

	intros c c_ss c_chain c_nonempty,
	use c.sUnion,

	split, swap, {exact λs hs, set.subset_sUnion_of_mem hs},
	by_contra hUcF,
	rw F_fin_char c.sUnion at hUcF, push_neg at hUcF,
	rcases hUcF with ⟨Y, Y_ss, Y_fin, hYF⟩,
	suffices : ∃b ∈ c, b ∉ F,	{rcases this with ⟨b, hb1, hb2⟩, exact hb2 (c_ss hb1)},
	have : ∀y ∈ Y, ∃Z ∈ c, y ∈ Z,
	{
		intros y hy,
		rcases Y_ss hy with ⟨Z, hZc, hyZ⟩,
		exact ⟨Z, hZc, hyZ⟩,
	},
	choose f hfc hf using this,
	have sub_chain_fin := set.finite.dependent_image Y_fin f,
	set sub_chain := {y : set α | ∃ (x : α) (hx : x ∈ Y), y = f x hx}
	with sub_chain_def,
	have sub_chain_ss : sub_chain ⊆ c,
	{
		intros Z hZ,
		rw sub_chain_def at hZ,
		simp at hZ,
		rcases hZ with ⟨y, hyY, hyf⟩,
		rw hyf,
		exact hfc y hyY,
	},
	have Y_nonempty : Y.nonempty,
	{
		rw← set.ne_empty_iff_nonempty,
		intro contra,
		rw contra at hYF,
		exact hYF (mem_empty_of_fin_character ⟨X, hX⟩ F_fin_char),
	},
	have sub_chain_nonempty : sub_chain.nonempty,
	{
		cases Y_nonempty with y hy,
		have : f y hy ∈ sub_chain, {rw sub_chain_def, simp,exact ⟨y, hy, rfl⟩},
		exact set.nonempty_of_mem this,
	},
	rcases max_of_fin_chain sub_chain_fin (is_chain.mono sub_chain_ss c_chain)
	sub_chain_nonempty with ⟨m, hmsub, hm⟩,
	use [m, sub_chain_ss hmsub],
	suffices : Y ⊆ m, {rw F_fin_char, push_neg, exact ⟨Y, this, Y_fin, hYF⟩},
	suffices : ∀y ∈ Y, ∃Z ∈ sub_chain, y ∈ Z,
	{
		intros y hy,
		rcases this y hy with ⟨Z, Z_sub, hyZ⟩,
		exact @hm Z Z_sub y hyZ,
	},

	intros y hy,
	use [f y hy, y, hy, rfl, hf y hy],
end


/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import combinatorics.simple_graph.trails
import tactic.derive_fintype

/-!
# The Königsberg bridges problem

We show that a graph that represents the islands and mainlands of Königsberg and seven bridges
between them has no Eulerian trail.
-/

namespace konigsberg

/-- The vertices for the Königsberg graph; four vertices for the bodies of land and seven
vertices for the bridges. -/
@[derive [decidable_eq, fintype], nolint has_inhabited_instance]
inductive verts : Type
| V1 | V2 | V3 | V4 -- The islands and mainlands
| B1 | B2 | B3 | B4 | B5 | B6 | B7 -- The bridges

open verts

/-- Each of the connections between the islands/mainlands and the bridges.
These are ordered pairs, but the data becomes symmetric in `konigsberg.adj`. -/
def edges : list (verts × verts) :=
[ (V1, B1), (V1, B2), (V1, B3), (V1, B4), (V1, B5),
  (B1, V2), (B2, V2), (B3, V4), (B4, V3), (B5, V3),
  (V2, B6), (B6, V4),
  (V3, B7), (B7, V4) ]

/-- The adjacency relation for the Königsberg graph. -/
def adj (v w : verts) : bool := ((v, w) ∈ edges) || ((w, v) ∈ edges)

/-- The Königsberg graph structure. While the Königsberg bridge problem
is usually described using a multigraph, the we use a "mediant" construction
to transform it into a simple graph -- every edge in the multigraph is subdivided
into a path of two edges. This construction preserves whether a graph is Eulerian.

(TODO: once mathlib has multigraphs, either prove the mediant construction preserves the
Eulerian property or switch this file to use multigraphs. -/
@[simps]
def graph : simple_graph verts :=
{ adj := λ v w, adj v w,
  symm := begin
    dsimp [symmetric, adj],
    dec_trivial,
  end,
  loopless := begin
    dsimp [irreflexive, adj],
    dec_trivial
  end }

instance : decidable_rel graph.adj := λ a b, decidable_of_bool (adj a b) iff.rfl

/-- To speed up the proof, this is a cache of all the degrees of each vertex,
proved in `konigsberg.degree_eq_degree`. -/
@[simp]
def degree : verts → ℕ
| V1 := 5 | V2 := 3 | V3 := 3 | V4 := 3
| B1 := 2 | B2 := 2 | B3 := 2 | B4 := 2 | B5 := 2 | B6 := 2 | B7 := 2

@[simp] lemma degree_eq_degree (v : verts) : graph.degree v = degree v := by cases v; refl

/-- The Königsberg graph is not Eulerian. -/
theorem not_is_eulerian {u v : verts} (p : graph.walk u v) (h : p.is_eulerian) : false :=
begin
  have : {v | odd (graph.degree v)} = {verts.V1, verts.V2, verts.V3, verts.V4},
  { ext w,
    simp only [degree_eq_degree, nat.odd_iff_not_even, set.mem_set_of_eq, set.mem_insert_iff,
      set.mem_singleton_iff],
    cases w; simp, },
  have h := h.card_odd_degree,
  simp_rw [this] at h,
  norm_num at h,
end

end konigsberg


section

variables A B C D : Prop

example : A ∧ (A → B) → B :=
assume h : A ∧ (A → B),
have g : A, from and.left h,
have i : A → B, from and.right h,
show B, from i g

theorem nny (ha : A) : ¬ (¬ A) :=
assume hna : ¬ A,
show false, from hna ha

#check nny

theorem notAnotB (h : ¬ A ∨ ¬ B) : ¬ (A ∧ B) :=
or.elim h
  (assume hna : ¬ A,
    assume hn : A ∧ B,
    show false, from hna (and.left hn))
  (assume hnb : ¬ B,
    assume hn : A ∧ B,
    show false, from hnb (and.right hn))

#check notAnotB

example : A → ¬ (¬ A ∧ B) :=
assume ha : A,
assume hnab : ¬ A ∧ B,
show false, from and.left hnab ha

example : ¬ (A ∧ B) → (A → ¬ B) :=
assume hnanb : ¬ (A ∧ B),
assume ha : A,
assume hb : B,
show false, from hnanb (and.intro ha hb)

example (h1 : A ∨ B) (h2 : A → C) (h3 : B → D) : C ∨ D :=
or.elim h1
  (assume h1a : A,
    show C ∨ D, from or.inl (h2 h1a))
  (assume h1b : B,
    show C ∨ D, from or.inr (h3 h1b))

example (h : ¬ A ∧ ¬ B) : ¬ (A ∨ B) :=
assume g : A ∨ B,
or.elim g
  (assume ga : A,
    show false, from (and.left h) ga)
  (assume gb : B,
    show false, from (and.right h) gb)

example : ¬ (A ∧ ¬ A) :=
assume h : A ∧ ¬ A,
show false, from and.right h (and.left h)

lemma AimpNotA (h : A → ¬ A) : ¬ A :=
assume g : A,
show false, from (h g) g

#check AimpNotA

example : ¬ (A ↔ ¬ A) :=
assume hiff : A ↔ ¬ A,
have hl : A → ¬ A, from iff.elim_left hiff,
have hr : ¬ A → A, from iff.elim_right hiff,
have hna : ¬ A, from
  assume h : A,
  show false, from (hl h) h,
have ha : A, from hr hna,
show false, from hna ha

end


import tactic
import data.nat.parity

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

def soucet_do_n' : ℕ → ℕ :=
λ n, n * (n + 1) / 2

theorem soucty_odpovidaji : soucet_do_n = soucet_do_n' :=
begin
  ext1,
  induction x with n ih,
  {
    refl,
  },
  unfold soucet_do_n,
  rw ih,
  unfold soucet_do_n',
  convert_to n + 1 + n * (n + 1) / 2 = (n + 1) * (n + 2) / 2,

  have pul_a_pul : ∀ x y : ℕ, even x → even y → x / 2 + y / 2 = (x + y) / 2,
  {
    intros x y hx hy,
    cases hx with x' hx',
    cases hy with y' hy',
    rw hx',
    rw hy',
    ring_nf,
    convert_to x' + y' = (2 * x' + 2 * y') / 2,
    {
      apply congr_arg2;
      norm_num,
    },
    rw ← mul_add,
    norm_num,
  },
  calc n + 1 + n * (n + 1) / 2
      = (n + 1) * 2 / 2 + n * (n + 1) / 2 : by norm_num
  ... = ((n + 1) * 2 + n * (n + 1)) / 2   : pul_a_pul _ _ ⟨n + 1, mul_two _⟩ (nat.even_mul_succ_self n)
  ... = ((2 + n) * (n + 1)) / 2           : by ring_nf
  ... = (n + 1) * (n + 2) / 2             : by ring_nf,
end


/-
Copyright (c) 2020 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa, Jujian Zhang

! This file was ported from Lean 3 source module number_theory.liouville.liouville_constant
! leanprover-community/mathlib commit 98cbfb459a053c5ca44aec69f0a5a932b84c0d67
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Liouville.Basic

/-!

# Liouville constants

This file contains a construction of a family of Liouville numbers, indexed by a natural number $m$.
The most important property is that they are examples of transcendental real numbers.
This fact is recorded in `liouville.is_transcendental`.

More precisely, for a real number $m$, Liouville's constant is
$$
\sum_{i=0}^\infty\frac{1}{m^{i!}}.
$$
The series converges only for $1 < m$.  However, there is no restriction on $m$, since,
if the series does not converge, then the sum of the series is defined to be zero.

We prove that, for $m \in \mathbb{N}$ satisfying $2 \le m$, Liouville's constant associated to $m$
is a transcendental number.  Classically, the Liouville number for $m = 2$ is the one called
``Liouville's constant''.

## Implementation notes

The indexing $m$ is eventually a natural number satisfying $2 ≤ m$.  However, we prove the first few
lemmas for $m \in \mathbb{R}$.
-/

noncomputable section

open Nat BigOperators

open Real Finset

namespace Liouville

/-- For a real number `m`, Liouville's constant is
$$
\sum_{i=0}^\infty\frac{1}{m^{i!}}.
$$
The series converges only for `1 < m`.  However, there is no restriction on `m`, since,
if the series does not converge, then the sum of the series is defined to be zero.
-/
def liouvilleNumber (m : ℝ) : ℝ :=
  ∑' i : ℕ, 1 / m ^ i !
#align liouville.liouville_number Liouville.liouvilleNumber

/-- `liouville_number_initial_terms` is the sum of the first `k + 1` terms of Liouville's constant,
i.e.
$$
\sum_{i=0}^k\frac{1}{m^{i!}}.
$$
-/
def liouvilleNumberInitialTerms (m : ℝ) (k : ℕ) : ℝ :=
  ∑ i in range (k + 1), 1 / m ^ i !
#align liouville.liouville_number_initial_terms Liouville.liouvilleNumberInitialTerms

/-- `liouville_number_tail` is the sum of the series of the terms in `liouville_number m`
starting from `k+1`, i.e
$$
\sum_{i=k+1}^\infty\frac{1}{m^{i!}}.
$$
-/
def liouvilleNumberTail (m : ℝ) (k : ℕ) : ℝ :=
  ∑' i, 1 / m ^ (i + (k + 1))!
#align liouville.liouville_number_tail Liouville.liouvilleNumberTail

theorem liouvilleNumberTail_pos {m : ℝ} (hm : 1 < m) (k : ℕ) : 0 < liouvilleNumberTail m k :=
  calc
    -- replace `0` with the constantly zero series `∑ i : ℕ, 0`
        (0 : ℝ) =
        ∑' i : ℕ, 0 :=
      tsum_zero.symm
    _ <
        liouvilleNumberTail m
          k :=-- to show that a series with non-negative terms has strictly positive sum it suffices
          -- to prove that
          -- 1. the terms of the zero series are indeed non-negative
          -- 2. the terms of our series are non-negative
          -- 3. one term of our series is strictly positive -- they all are, we use the first term
          tsum_lt_tsum_of_nonneg
          (fun _ => rfl.le) (fun i => one_div_nonneg.mpr (pow_nonneg (zero_le_one.trans hm.le) _))
          (one_div_pos.mpr
            (pow_pos (zero_lt_one.trans hm)
              (0 +
                  (k +
                    1))!)) <|-- 4. our series converges -- it does since it is the tail of a converging series, though
          -- this is not the argument here.
          summable_one_div_pow_of_le
          hm fun i => trans le_self_add (Nat.self_le_factorial _)

#align liouville.liouville_number_tail_pos Liouville.liouvilleNumberTail_pos

/-- Split the sum definining a Liouville number into the first `k` term and the rest. -/
theorem liouvilleNumber_eq_initial_terms_add_tail {m : ℝ} (hm : 1 < m) (k : ℕ) :
    liouvilleNumber m = liouvilleNumberInitialTerms m k + liouvilleNumberTail m k :=
  (sum_add_tsum_nat_add _ (summable_one_div_pow_of_le hm fun i => i.self_le_factorial)).symm
#align liouville.liouville_number_eq_initial_terms_add_tail Liouville.liouvilleNumber_eq_initial_terms_add_tail

/-! We now prove two useful inequalities, before collecting everything together. -/

/-- Partial inequality, works with `m ∈ ℝ` satisfying `1 < m`. -/
theorem tsum_one_div_pow_factorial_lt (n : ℕ) {m : ℝ} (m1 : 1 < m) :
    (∑' i : ℕ, 1 / m ^ (i + (n + 1))!) < (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :=
  have
    m0 :-- two useful inequalities
      0 <
      m :=
    zero_lt_one.trans m1
  have mi : |1 / m| < 1 :=
    (le_of_eq (abs_of_pos (one_div_pos.mpr m0))).trans_lt ((div_lt_one m0).mpr m1)
  calc
    (∑' i, 1 / m ^ (i + (n + 1))!) <
        ∑' i,
          1 /
            m ^
              (i + (n + 1)!) :=-- to show the strict inequality between these series, we prove that:
        tsum_lt_tsum_of_nonneg
        (-- 1. the first series has non-negative terms
        fun b => one_div_nonneg.mpr (pow_nonneg m0.le _))
        (-- 2. the second series dominates the first
        fun b =>
          one_div_pow_le_one_div_pow_of_le m1.le (b.add_factorial_succ_le_factorial_add_succ n))
        (-- 3. the term with index `i = 2` of the first series is strictly smaller than
          -- the corresponding term of the second series
          one_div_pow_strictAnti
          m1 (n.add_factorial_succ_lt_factorial_add_succ rfl.le))
        (-- 4. the second series is summable, since its terms grow quickly
          summable_one_div_pow_of_le
          m1 fun j => Nat.le.intro rfl)
    _ = ∑' i, (1 / m) ^ i * (1 / m ^ (n + 1)!) :=-- split the sum in the exponent and massage
    by
      congr
      ext i
      rw [pow_add, ← div_div, div_eq_mul_one_div, one_div_pow]
    -- factor the constant `(1 / m ^ (n + 1)!)` out of the series
        _ =
        (∑' i, (1 / m) ^ i) * (1 / m ^ (n + 1)!) :=
      tsum_mul_right
    _ = (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :=-- the series if the geometric series
          mul_eq_mul_right_iff.mpr
        (Or.inl (tsum_geometric_of_abs_lt_1 mi))

#align liouville.tsum_one_div_pow_factorial_lt Liouville.tsum_one_div_pow_factorial_lt

theorem aux_calc (n : ℕ) {m : ℝ} (hm : 2 ≤ m) :
    (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 1 / (m ^ n !) ^ n :=
  calc
    (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤
        2 * (1 / m ^ (n + 1)!) :=-- the second factors coincide (and are non-negative),
        -- the first factors, satisfy the inequality `sub_one_div_inv_le_two`
        mul_le_mul_of_nonneg_right
        (sub_one_div_inv_le_two hm) (by positivity)
    _ = 2 / m ^ (n + 1)! := (mul_one_div 2 _)
    _ = 2 / m ^ (n ! * (n + 1)) := (congr_arg ((· / ·) 2) (congr_arg (pow m) (mul_comm _ _)))
    _ ≤ 1 / m ^ (n ! * n) :=
      by
      -- [ NB: in this block, I do not follow the brace convention for subgoals -- I wait until
      --   I solve all extraneous goals at once with `exact pow_pos (zero_lt_two.trans_le hm) _`. ]
      -- Clear denominators and massage*
      apply (div_le_div_iff _ _).mpr
      conv_rhs => rw [one_mul, mul_add, pow_add, mul_one, pow_mul, mul_comm, ← pow_mul]
      -- the second factors coincide, so we prove the inequality of the first factors*
      refine' (mul_le_mul_right _).mpr _
      -- solve all the inequalities `0 < m ^ ??`
      any_goals exact pow_pos (zero_lt_two.trans_le hm) _
      -- `2 ≤ m ^ n!` is a consequence of monotonicity of exponentiation at `2 ≤ m`.
      exact trans (trans hm (pow_one _).symm.le) (pow_mono (one_le_two.trans hm) n.factorial_pos)
    _ = 1 / (m ^ n !) ^ n := congr_arg ((· / ·) 1) (pow_mul m n ! n)

#align liouville.aux_calc Liouville.aux_calc

/-!  Starting from here, we specialize to the case in which `m` is a natural number. -/

/-- The sum of the `k` initial terms of the Liouville number to base `m` is a ratio of natural
numbers where the denominator is `m ^ k!`. -/
theorem liouville_number_rat_initial_terms {m : ℕ} (hm : 0 < m) (k : ℕ) :
    ∃ p : ℕ, liouvilleNumberInitialTerms m k = p / m ^ k ! :=
  by
  induction' k with k h
  · exact ⟨1, by rw [liouville_number_initial_terms, range_one, sum_singleton, Nat.cast_one]⟩
  · rcases h with ⟨p_k, h_k⟩
    use p_k * m ^ ((k + 1)! - k !) + 1
    unfold liouville_number_initial_terms at h_k⊢
    rw [sum_range_succ, h_k, div_add_div, div_eq_div_iff, add_mul]
    · norm_cast
      rw [add_mul, one_mul, Nat.factorial_succ,
        show k.succ * k ! - k ! = (k.succ - 1) * k ! by rw [tsub_mul, one_mul], Nat.succ_sub_one,
        add_mul, one_mul, pow_add]
      simp [mul_assoc]
    refine' mul_ne_zero_iff.mpr ⟨_, _⟩
    all_goals exact pow_ne_zero _ (nat.cast_ne_zero.mpr hm.ne.symm)
#align liouville.liouville_number_rat_initial_terms Liouville.liouville_number_rat_initial_terms

theorem is_liouville {m : ℕ} (hm : 2 ≤ m) : Liouville (liouvilleNumber m) :=
  by
  -- two useful inequalities
  have mZ1 : 1 < (m : ℤ) := by
    norm_cast
    exact one_lt_two.trans_le hm
  have m1 : 1 < (m : ℝ) := by
    norm_cast
    exact one_lt_two.trans_le hm
  intro n
  -- the first `n` terms sum to `p / m ^ k!`
  rcases liouville_number_rat_initial_terms (zero_lt_two.trans_le hm) n with ⟨p, hp⟩
  refine' ⟨p, m ^ n !, one_lt_pow mZ1 n.factorial_ne_zero, _⟩
  push_cast
  -- separate out the sum of the first `n` terms and the rest
  rw [liouville_number_eq_initial_terms_add_tail m1 n, ← hp, add_sub_cancel',
    abs_of_nonneg (liouville_number_tail_pos m1 _).le]
  exact
    ⟨((lt_add_iff_pos_right _).mpr (liouville_number_tail_pos m1 n)).Ne.symm,
      (tsum_one_div_pow_factorial_lt n m1).trans_le
        (aux_calc _ (nat.cast_two.symm.le.trans (nat.cast_le.mpr hm)))⟩
#align liouville.is_liouville Liouville.is_liouville

/- Placing this lemma outside of the `open/closed liouville`-namespace would allow to remove
`_root_.`, at the cost of some other small weirdness. -/
theorem is_transcendental {m : ℕ} (hm : 2 ≤ m) : Transcendental ℤ (liouvilleNumber m) :=
  transcendental (is_liouville hm)
#align liouville.is_transcendental Liouville.is_transcendental

end Liouville


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

import data.polynomial.algebra_map
import data.polynomial.hasse_deriv

/-!
# Taylor expansions of polynomials

## Main declarations

* `polynomial.taylor`: the Taylor expansion of the polynomial `f` at `r`
* `polynomial.taylor_coeff`: the `k`th coefficient of `taylor r f` is
  `(polynomial.hasse_deriv k f).eval r`
* `polynomial.eq_zero_of_hasse_deriv_eq_zero`:
  the identity principle: a polynomial is 0 iff all its Hasse derivatives are zero

-/

noncomputable theory

namespace polynomial
open_locale polynomial

variables {R : Type*} [semiring R] (r : R) (f : R[X])

/-- The Taylor expansion of a polynomial `f` at `r`. -/
def taylor (r : R) : R[X] →ₗ[R] R[X] :=
{ to_fun := λ f, f.comp (X + C r),
  map_add' := λ f g, add_comp,
  map_smul' := λ c f, by simp only [smul_eq_C_mul, C_mul_comp, ring_hom.id_apply] }

lemma taylor_apply : taylor r f = f.comp (X + C r) := rfl

@[simp] lemma taylor_X : taylor r X = X + C r :=
by simp only [taylor_apply, X_comp]

@[simp] lemma taylor_C (x : R) : taylor r (C x) = C x :=
by simp only [taylor_apply, C_comp]

@[simp] lemma taylor_zero' : taylor (0 : R) = linear_map.id :=
begin
  ext,
  simp only [taylor_apply, add_zero, comp_X, _root_.map_zero, linear_map.id_comp, function.comp_app,
             linear_map.coe_comp]
end

lemma taylor_zero (f : R[X]) : taylor 0 f = f :=
by rw [taylor_zero', linear_map.id_apply]

@[simp] lemma taylor_one : taylor r (1 : R[X]) = C 1 :=
by rw [← C_1, taylor_C]

@[simp] lemma taylor_monomial (i : ℕ) (k : R) : taylor r (monomial i k) = C k * (X + C r) ^ i :=
by simp [taylor_apply]

/-- The `k`th coefficient of `polynomial.taylor r f` is `(polynomial.hasse_deriv k f).eval r`. -/
lemma taylor_coeff (n : ℕ) : (taylor r f).coeff n = (hasse_deriv n f).eval r :=
show (lcoeff R n).comp (taylor r) f = (leval r).comp (hasse_deriv n) f,
begin
  congr' 1, clear f, ext i,
  simp only [leval_apply, mul_one, one_mul, eval_monomial, linear_map.comp_apply, coeff_C_mul,
    hasse_deriv_monomial, taylor_apply, monomial_comp, C_1,
    (commute_X (C r)).add_pow i, linear_map.map_sum],
  simp only [lcoeff_apply, ← C_eq_nat_cast, mul_assoc, ← C_pow, ← C_mul, coeff_mul_C,
    (nat.cast_commute _ _).eq, coeff_X_pow, boole_mul, finset.sum_ite_eq, finset.mem_range],
  split_ifs with h, { refl },
  push_neg at h, rw [nat.choose_eq_zero_of_lt h, nat.cast_zero, mul_zero],
end

@[simp] lemma taylor_coeff_zero : (taylor r f).coeff 0 = f.eval r :=
by rw [taylor_coeff, hasse_deriv_zero, linear_map.id_apply]

@[simp] lemma taylor_coeff_one : (taylor r f).coeff 1 = f.derivative.eval r :=
by rw [taylor_coeff, hasse_deriv_one]

@[simp] lemma nat_degree_taylor (p : R[X]) (r : R) :
  nat_degree (taylor r p) = nat_degree p :=
begin
  refine map_nat_degree_eq_nat_degree _ _,
  nontriviality R,
  intros n c c0,
  simp [taylor_monomial, nat_degree_C_mul_eq_of_mul_ne_zero, nat_degree_pow_X_add_C, c0]
end

@[simp] lemma taylor_mul {R} [comm_semiring R] (r : R) (p q : R[X]) :
  taylor r (p * q) = taylor r p * taylor r q :=
by simp only [taylor_apply, mul_comp]

/-- `polynomial.taylor` as a `alg_hom` for commutative semirings -/
@[simps apply] def taylor_alg_hom {R} [comm_semiring R] (r : R) : R[X] →ₐ[R] R[X] :=
alg_hom.of_linear_map (taylor r) (taylor_one r) (taylor_mul r)

lemma taylor_taylor {R} [comm_semiring R] (f : R[X]) (r s : R) :
  taylor r (taylor s f) = taylor (r + s) f :=
by simp only [taylor_apply, comp_assoc, map_add, add_comp, X_comp, C_comp, C_add, add_assoc]

lemma taylor_eval {R} [comm_semiring R] (r : R) (f : R[X]) (s : R) :
  (taylor r f).eval s = f.eval (s + r) :=
by simp only [taylor_apply, eval_comp, eval_C, eval_X, eval_add]

lemma taylor_eval_sub {R} [comm_ring R] (r : R) (f : R[X]) (s : R) :
  (taylor r f).eval (s - r) = f.eval s :=
by rw [taylor_eval, sub_add_cancel]

lemma taylor_injective {R} [comm_ring R] (r : R) : function.injective (taylor r) :=
begin
  intros f g h,
  apply_fun taylor (-r) at h,
  simpa only [taylor_apply, comp_assoc, add_comp, X_comp, C_comp, C_neg,
    neg_add_cancel_right, comp_X] using h,
end

/-- Taylor's formula. -/
lemma sum_taylor_eq {R} [comm_ring R] (f : R[X]) (r : R) :
  (taylor r f).sum (λ i a, C a * (X - C r) ^ i) = f :=
by rw [←comp_eq_sum_left, sub_eq_add_neg, ←C_neg, ←taylor_apply, taylor_taylor, neg_add_self,
       taylor_zero]

end polynomial


import data.int.basic tactic.pure_maths -- hide

/-
# Propositional logic
## Level 1: And elimination

Let $p$ and $q$ be propositions (mathematical statements). The formal statement $p \land q$
(read '$p$ conjunction $q$')
corresponds to the informal statement '$p$ and $q$'.

Suppose you are given a hypothesis `h : p ∧ q`. Then

1. [left and elimination] `h.left` is a proof of `p` and
2. [right and elimination] `h.right` is a proof of `q`.

Here, `h.left` is an abbreviation for `and.elim_left h`. Likewise for `h.right`.

**Theorem**: Let $x$ be an integer. Supose $h : (x > 0) \land (x ^ 2 = 16)$. Then $x ^ 2 = 16$.

**Proof**: The result follows from right and elimination on $h$. ∎

The Lean proof is below.

**Notation**: the symbol `∧` in Lean is typed `\and`.
-/

/- Axiom : and.elim_left (h : p ∧ q) :
p
-/

/- Axiom : and.elim_right (h : p ∧ q) :
q
-/

example (x : ℤ) (h : (x > 0) ∧ (x * x = 16)) : x * x = 16 :=
begin
  from h.right,
end

/-
Alternatively, the `cases` tactic will decompose the `∧` into both the left and right sides.
Below `cases h with h₁ h₂` decomposes `h` into `h₁ : x > 0` and `h₂ : x * x = 16`.
-/

example (x : ℤ) (h : (x > 0) ∧ (x * x = 16)) : x * x = 16  :=
begin
  cases h with h₁ h₂,
  show x * x = 16, from h₂,
end

/-
Frequently, we consider the conjunction of several statements.
We can, for instance, derive $q$ given the assumption $p \land (q \land r).
-/

example (p q r : Prop) (h : p ∧ (q ∧ r)) : q :=
begin
  have h₂ : q ∧ r, from h.right,
  show q, from h₂.left,
end

/- Tactic : cases
`cases` is a general-purpose elimination tactic. It it used to 'decompose' a hypothesis into
its constituent parts.

### Examples

* Given `h : ∃ (x : ℤ), x + 5 = y`, typing `cases h with m h₂` replaces `h` with `m : ℤ` and
`h₂ : m + 5 = y`.

* Given `h : p ∧ q`, typing `cases h with hp hq` replaces `h` with `hp : p` and `hq : q`.

* Given `h : p ∨ q`, typing `cases h with hp hq` replaces the current goal with two goals
(1) in which `h` is replaced with `hp : p` and (2) in which `h` is replaced with `hq : q`.

* Given `x : ℕ`, typing `cases x with k` replaces the goal with two new goals: (1) a goal in which
every occurence of `x` is replaced with `0` and (2) a goal with a new variable `k : ℕ` and in
which every occurrence of `x` is replaced with `succ k`.

* Given `h : ∃ (x : X), P(x)`, typing `cases h with y h₂` introduces a new variable `y : X`
and replaces `h` with `h₂ : P(y)`.
-/

namespace exlean -- hide

/-
## Tasks

1. Replace `sorry` below with a Lean proof using `have` together with left and right and elimination.
Adapt the proof of the example above.
2. Write another Lean proof using `cases`.
3. On a piece of paper, state and give a handwritten proof of this result.
-/

/- Theorem : no-side-bar
Let $p$, $q$, and $r$ be propositions. Assuming $h : (r \land (p \land q)) \land r$,
we have $q$.
-/
theorem decomposing_and (p q r : Prop) (h : (r ∧ (p ∧ q)) ∧ r) :
q :=
begin
  have h₂ : r ∧ (p ∧ q), from h.left,
  have h₃ : p ∧ q, from h₂.right,
  show q, from h₃.right,

end

end exlean -- hide


-- Pruebas de la distributiva del producto sobre sumas
-- ===================================================

import data.nat.basic
open nat
open list

variables {α : Type*} {β : Type*}
variable  (x : α)
variables (xs : list α)
variable  (n : ℕ)
variable  (ns : list ℕ)

-- ----------------------------------------------------
-- Nota. Se usará la función aplica y sus propiedades
-- estudiadas anteriormente.
-- ----------------------------------------------------

def aplica : (α → β) → list α → list β
| f []        := []
| f (x :: xs) := (f x) :: aplica f xs

@[simp]
lemma aplica_nil
  (f : α → β)
  : aplica f [] = [] :=
rfl

@[simp]
lemma aplica_cons
  (f : α → β)
  : aplica f (x :: xs) = (f x) :: aplica f xs :=
rfl

-- ----------------------------------------------------
-- Ejercicio 1. Definir la función
--    suma : list ℕ → ℕ
-- tal que (suma xs) es la suma de los elementos de
-- xs. Por ejemplo,
--    suma [3,2,5] = 10
-- ----------------------------------------------------

def suma : list ℕ → ℕ
| []        := 0
| (n :: ns) := n + suma ns

-- #eval suma [3,2,5]

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar los siguientes lemas
-- + suma_nil :
--      suma ([] : list ℕ) = 0 :=
-- + suma_cons :
--      suma (n :: ns) = n + suma ns :=
-- ----------------------------------------------------

@[simp]
lemma suma_nil :
  suma ([] : list ℕ) = 0 :=
rfl

@[simp]
lemma suma_cons :
  suma (n :: ns) = n + suma ns :=
rfl

-- ----------------------------------------------------
-- Ejercicio 3. (p. 45) Demostrar que
--    suma (aplica (λ x, 2*x) ns) = 2 * (suma ns)
-- ----------------------------------------------------

-- 1ª demostración
example :
  suma (aplica (λ x, 2*x) ns) = 2 * (suma ns) :=
begin
  induction ns with m ms HI,
  { rw aplica_nil,
    rw suma_nil,
    rw nat.mul_zero, },
  { rw aplica_cons,
    rw suma_cons,
    rw HI,
    rw suma_cons,
    rw mul_add, },
end

-- 2ª demostración
example :
  suma (aplica (λ x, 2*x) ns) = 2 * (suma ns) :=
begin
  induction ns with m ms HI,
  { calc suma (aplica (λ (x : ℕ), 2 * x) [])
         = suma []                                : by rw aplica_nil
     ... = 0                                      : by rw suma_nil
     ... = 2 * 0                                  : by rw nat.mul_zero
     ... = 2 * suma []                            : by rw suma_nil, },
  { calc suma (aplica (λ x, 2 * x) (m :: ms))
         = suma (2 * m :: aplica (λ x, 2 * x) ms) : by rw aplica_cons
     ... = 2 * m + suma (aplica (λ x, 2 * x) ms)  : by rw suma_cons
     ... = 2 * m + 2 * suma ms                    : by rw HI
     ... = 2 * (m + suma ms)                      : by rw mul_add
     ... = 2 * suma (m :: ms)                     : by rw suma_cons, },
end

-- 3ª demostración
example :
  suma (aplica (λ x, 2*x) ns) = 2 * (suma ns) :=
begin
  induction ns with m ms HI,
  { simp, },
  { simp [HI, mul_add], },
end

-- 4ª demostración
example :
  suma (aplica (λ x, 2*x) ns) = 2 * (suma ns) :=
by induction ns ; simp [*, mul_add]

-- 5ª demostración
lemma suma_aplica :
  ∀ ns, suma (aplica (λ x, 2*x) ns) = 2 * (suma ns)
| []        := by simp
| (m :: ms) := by simp [suma_aplica ms, mul_add]

-- Comentarios sobre las funciones sum y map:
-- + Son equivalentes a las funciones suma y aplica.
-- + Para usarla hay que importar la librería
--   data.list.basic y abrir el espacio de nombre
--   list escribiendo al principio del fichero
--      import data.list.basic
--      open list
-- + Se puede evaluar. Por ejemplo,
--      #eval sum [3,2,5]
--      #eval map (λx, 2*x) [3,2,5]
--      #eval map ((*) 2) [3,2,5]
--      #eval map ((+) 2) [3,2,5]


import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space

import data.equiv.basic

local attribute [instance] classical.prop_decidable

universes u v w

open set filter lattice classical

definition is_open_sets {α : Type u} (is_open : set α → Prop) :=
  is_open univ ∧ (∀s t, is_open s → is_open t → is_open (s ∩ t)) ∧ (∀s, (∀t∈s, is_open t) → is_open (⋃₀ s))

definition is_to_top {α : Type u} (is_open : set α → Prop) (H : is_open_sets (is_open)) : topological_space α :=
{ is_open := is_open,
  is_open_univ := H.left,
  is_open_inter := H.right.left,
  is_open_sUnion := H.right.right
}

definition top_to_is {α : Type u} (T : topological_space α) : is_open_sets (T.is_open) :=
⟨T.is_open_univ,T.is_open_inter,T.is_open_sUnion⟩

--Definition 9.9
definition topology_dense {α : Type u} [topological_space α] (s : set α) : Prop := closure s = univ

--Proposition 9.11
theorem continuous_iff_image_closure_subset_closure_image {α : Type u} {β : Type v} [topological_space α] [topological_space β] (f : α → β) :
continuous f ↔ ∀ s, f '' closure s ⊆ closure (f '' s) :=
begin
  split,
    intros Hf s,
    exact image_closure_subset_closure_image Hf,
  intros Hf,
  rw continuous_iff_is_closed,
  intros b Hb,
  let f_inv_b := f ⁻¹' (b),
  let f_f_inv_b := f '' f_inv_b,
  have H1 : f '' (closure f_inv_b) ⊆ closure (f '' f_inv_b), by exact Hf f_inv_b,
  have H2 : closure (f '' f_inv_b) ⊆ closure b, by exact closure_mono (set.image_preimage_subset f b),
  have H3 : closure b = b, by exact closure_eq_of_is_closed Hb,
  rw H3 at H2,
  have H4 : f '' (closure f_inv_b) ⊆ b := set.subset.trans H1 H2,
  have H5 : f ⁻¹' (f '' closure f_inv_b) ⊆ f ⁻¹' b := set.preimage_mono H4,
  have H6 : closure f_inv_b ⊆ f_inv_b := set.subset.trans (set.subset_preimage_image f (closure f_inv_b)) H5,
  exact closure_eq_iff_is_closed.1 (set.eq_of_subset_of_subset H6 subset_closure),
end

--Prooposition 9.13
lemma closure_sInter' {α : Type u} [topological_space α] {I : set (set α)} :
closure (sInter I) ⊆ (⋂ (i ∈ I), closure i) :=
begin
  have H1 : ⋂₀ I ⊆ ⋂ (i ∈ I), closure i,
    apply subset_bInter,
    intros x Hx,
    exact subset.trans (sInter_subset_of_mem Hx) subset_closure,
  have H2 : is_closed (⋂ (i : set α) (H : i ∈ I), closure i),
    have H6 : (⋂ (i : set α) (H : i ∈ I), closure i) = ⋂ (i : I), closure i,
      apply set.ext,
      intro x, simp,
      split, intro Hx,
      intros i Hi,
      exact Hx i Hi,
      intro Hx,
      intros x_1 Hx_1,
      exact Hx x_1 Hx_1,

  have H7 : is_closed (⋂ (i : I), closure ↑i) := @is_closed_Inter α _ _ _ (λ (i : I), @is_closed_closure _ _ ↑i),
  rw ←H6 at H7,
  assumption,
    have H3 : closure ⋂₀ I ⊆ closure ⋂ (i ∈ I), closure i := closure_mono H1,

    have H4 : @closure α _ (⋂ (i ∈ I), closure i) = ⋂ (i ∈ I), closure i,
      apply closure_eq_of_is_closed,
      exact H2,
    rw H4 at H3,
    exact H3,
end

#print Inter

--Corollary 9.21
lemma frontier_eq_frontier_compl {α : Type u} [topological_space α] {s : set α} : frontier s = frontier (-s) :=
begin
rw frontier_eq_closure_inter_closure, rw frontier_eq_closure_inter_closure,
finish,
end
--What should I have done instead of finish??


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-

# More on functions

Another question on the Imperial introduction to proof problem sheet on functions
is "If `f : X → Y` and `g : Y → Z` and `g ∘ f` is injective, is it true that `g` is injective?"
This is not true. A counterexample could be made by letting `X` and `Z` have one element,
and letting `Y` have two elements; `f` and `g` are then not hard to write down. Let's
see how to do this in Lean by making inductive types `X`, `Y` and `Z` and functions
`f` and `g` which give an explicit counterexample.

-/

-- Let X be {a}
inductive X : Type
| a : X

-- in fact the term of type X is called `X.a`.

-- Let Y be {b,c}
inductive Y : Type
| b : Y
| c : Y

inductive Z : Type
| d : Z

-- Define f by f(X.a)=Y.b
def f : X → Y
| X.a := Y.b

-- define g by g(Y.b)=g(Y.c)=Z.d
def g : Y → Z
| Y.b := Z.d
| Y.c := Z.d

-- examples of how these things work
example (z : Z) : z = Z.d :=
begin
  cases z,
  refl,
end

example : Y.b ≠ Y.c :=
begin
  intro h, -- x ≠ y is definitionally equal to (x = y) → false
  cases h, -- no cases when they're equal!
end

open function

lemma gf_injective : injective (g ∘ f) :=
begin
  sorry,
end

-- This is a question on the IUM (Imperial introduction to proof course) function problem sheet
example : ¬ (∀ X Y Z : Type, ∀ (f : X → Y) (g : Y → Z), injective (g ∘ f) → injective g) :=
begin
  sorry,
end

-- This is another one
example : ¬ (∀ X Y Z : Type, ∀ (f : X → Y) (g : Y → Z), surjective (g ∘ f) → surjective f) :=
begin
  sorry,
end


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import analysis.normed_space.finite_dimension
import field_theory.tower
import data.is_R_or_C.basic

/-! # Further lemmas about `is_R_or_C` -/

variables {K E : Type*} [is_R_or_C K]

namespace polynomial

open_locale polynomial

lemma of_real_eval (p : ℝ[X]) (x : ℝ) : (p.eval x : K) = aeval ↑x p :=
(@aeval_algebra_map_apply_eq_algebra_map_eval ℝ K _ _ _ x p).symm

end polynomial

namespace finite_dimensional

open_locale classical
open is_R_or_C

/-- This instance generates a type-class problem with a metavariable `?m` that should satisfy
`is_R_or_C ?m`. Since this can only be satisfied by `ℝ` or `ℂ`, this does not cause problems. -/
library_note "is_R_or_C instance"

/-- An `is_R_or_C` field is finite-dimensional over `ℝ`, since it is spanned by `{1, I}`. -/
@[nolint dangerous_instance] instance is_R_or_C_to_real : finite_dimensional ℝ K :=
⟨⟨{1, I},
  begin
    rw eq_top_iff,
    intros a _,
    rw [finset.coe_insert, finset.coe_singleton, submodule.mem_span_insert],
    refine ⟨re a, (im a) • I, _, _⟩,
    { rw submodule.mem_span_singleton,
      use im a },
    simp [re_add_im a, algebra.smul_def, algebra_map_eq_of_real]
  end⟩⟩

variables (K E) [normed_add_comm_group E] [normed_space K E]

/-- A finite dimensional vector space over an `is_R_or_C` is a proper metric space.

This is not an instance because it would cause a search for `finite_dimensional ?x E` before
`is_R_or_C ?x`. -/
lemma proper_is_R_or_C [finite_dimensional K E] : proper_space E :=
begin
  letI : normed_space ℝ E := restrict_scalars.normed_space ℝ K E,
  letI : finite_dimensional ℝ E := finite_dimensional.trans ℝ K E,
  apply_instance
end

variable {E}

instance is_R_or_C.proper_space_submodule (S : submodule K E) [finite_dimensional K ↥S] :
  proper_space S :=
proper_is_R_or_C K S

end finite_dimensional

namespace is_R_or_C

@[simp, is_R_or_C_simps] lemma re_clm_norm : ‖(re_clm : K →L[ℝ] ℝ)‖ = 1 :=
begin
  apply le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _),
  convert continuous_linear_map.ratio_le_op_norm _ (1 : K),
  { simp },
  { apply_instance }
end

@[simp, is_R_or_C_simps] lemma conj_cle_norm : ‖(@conj_cle K _ : K →L[ℝ] K)‖ = 1 :=
(@conj_lie K _).to_linear_isometry.norm_to_continuous_linear_map

@[simp, is_R_or_C_simps] lemma of_real_clm_norm : ‖(of_real_clm : ℝ →L[ℝ] K)‖ = 1 :=
linear_isometry.norm_to_continuous_linear_map of_real_li

end is_R_or_C


/-
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 order.min_max
import data.set.prod

/-!
# Intervals

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

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
-/

open function order_dual (to_dual of_dual)

variables {α β : Type*}

namespace set
section preorder
variables [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

instance decidable_mem_Ioo [decidable (a < x ∧ x < b)] : decidable (x ∈ Ioo a b) := by assumption
instance decidable_mem_Ico [decidable (a ≤ x ∧ x < b)] : decidable (x ∈ Ico a b) := by assumption
instance decidable_mem_Iio [decidable (x < b)] : decidable (x ∈ Iio b) := by assumption
instance decidable_mem_Icc [decidable (a ≤ x ∧ x ≤ b)] : decidable (x ∈ Icc a b) := by assumption
instance decidable_mem_Iic [decidable (x ≤ b)] : decidable (x ∈ Iic b) := by assumption
instance decidable_mem_Ioc [decidable (a < x ∧ x ≤ b)] : decidable (x ∈ Ioc a b) := by assumption
instance decidable_mem_Ici [decidable (a ≤ x)] : decidable (x ∈ Ici a) := by assumption
instance decidable_mem_Ioi [decidable (a < x)] : decidable (x ∈ Ioi a) := by assumption

@[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

instance [no_min_order α] : no_min_order (Iio a) :=
⟨λ a, let ⟨b, hb⟩ := exists_lt (a : α) in ⟨⟨b, lt_trans hb a.2⟩, hb⟩⟩

instance [no_min_order α] : no_min_order (Iic a) :=
⟨λ a, let ⟨b, hb⟩ := exists_lt (a : α) in ⟨⟨b, hb.le.trans a.2⟩, hb⟩⟩

instance [no_max_order α] : no_max_order (Ioi a) :=
order_dual.no_max_order (Iio (to_dual a))

instance [no_max_order α] : no_max_order (Ici a) :=
order_dual.no_max_order (Iic (to_dual a))

@[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 αᵒᵈ _ _ _

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 Ioi_ssubset_Ici_self  : Ioi a ⊂ Ici a := ⟨Ioi_subset_Ici_self, λ h, lt_irrefl a (h le_rfl)⟩

lemma Iio_ssubset_Iic_self : Iio a ⊂ Iic a := @Ioi_ssubset_Ici_self αᵒᵈ _ _

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 Iic_inter_Ici : Iic a ∩ Ici b = Icc b a := inter_comm _ _
lemma Iio_inter_Ici : Iio a ∩ Ici b = Ico b a := inter_comm _ _
lemma Iic_inter_Ioi : Iic a ∩ Ioi b = Ioc b a := inter_comm _ _
lemma Iio_inter_Ioi : Iio a ∩ Ioi b = Ioo b a := inter_comm _ _

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 [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

@[simp] lemma Ico_insert_right (h : a ≤ b) : insert b (Ico a b) = Icc a b :=
by rw [insert_eq, union_comm, Ico_union_right h]

@[simp] lemma Ioc_insert_left (h : a ≤ b) : insert a (Ioc a b) = Icc a b :=
by rw [insert_eq, union_comm, Ioc_union_left h]

@[simp] lemma Ioo_insert_left (h : a < b) : insert a (Ioo a b) = Ico a b :=
by rw [insert_eq, union_comm, Ioo_union_left h]

@[simp] lemma Ioo_insert_right (h : a < b) : insert b (Ioo a b) = Ioc a b :=
by rw [insert_eq, union_comm, Ioo_union_right h]

@[simp] lemma Iio_insert : insert a (Iio a) = Iic a := ext $ λ _, le_iff_eq_or_lt.symm

@[simp] lemma Ioi_insert : insert a (Ioi a) = Ici a :=
ext $ λ _, (or_congr_left' eq_comm).trans le_iff_eq_or_lt.symm

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 αᵒᵈ _ 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

lemma Ici_injective : injective (Ici : α → set α) := λ a b, eq_of_forall_ge_iff ∘ set.ext_iff.1
lemma Iic_injective : injective (Iic : α → set α) := λ a b, eq_of_forall_le_iff ∘ set.ext_iff.1

lemma Ici_inj : Ici a = Ici b ↔ a = b := Ici_injective.eq_iff
lemma Iic_inj : Iic a = Iic b ↔ a = b := Iic_injective.eq_iff

end partial_order

section order_top

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

variables [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 [partial_order α] [order_bot α] : Iic (⊥ : α) = {⊥} :=
is_min_bot.Iic_eq

variables [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

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

section linear_order
variables [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

@[simp] lemma not_mem_Ioi_self : a ∉ Ioi a := lt_irrefl _

@[simp] lemma not_mem_Iio_self : b ∉ Iio b := lt_irrefl _

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 Ioi_injective : injective (Ioi : α → set α) := λ a b, eq_of_forall_gt_iff ∘ set.ext_iff.1
lemma Iio_injective : injective (Iio : α → set α) := λ a b, eq_of_forall_lt_iff ∘ set.ext_iff.1

lemma Ioi_inj : Ioi a = Ioi b ↔ a = b := Ioi_injective.eq_iff
lemma Iio_inj : Iio a = Iio b ↔ a = b := Iio_injective.eq_iff

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 αᵒᵈ _ 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 -/

lemma Iic_union_Ioi_of_le (h : a ≤ b) : Iic b ∪ Ioi a = univ :=
eq_univ_of_forall $ λ x, (h.lt_or_le x).symm

lemma Iio_union_Ici_of_le (h : a ≤ b) : Iio b ∪ Ici a = univ :=
eq_univ_of_forall $ λ x, (h.le_or_lt x).symm

lemma Iic_union_Ici_of_le (h : a ≤ b) : Iic b ∪ Ici a = univ :=
eq_univ_of_forall $ λ x, (h.le_or_le x).symm

lemma Iio_union_Ioi_of_lt (h : a < b) : Iio b ∪ Ioi a = univ :=
eq_univ_of_forall $ λ x, (h.lt_or_lt x).symm

@[simp] lemma Iic_union_Ici : Iic a ∪ Ici a = univ := Iic_union_Ici_of_le le_rfl
@[simp] lemma Iio_union_Ici : Iio a ∪ Ici a = univ := Iio_union_Ici_of_le le_rfl
@[simp] lemma Iic_union_Ioi : Iic a ∪ Ioi a = univ := Iic_union_Ioi_of_le le_rfl
@[simp] lemma Iio_union_Ioi : Iio a ∪ Ioi a = {a}ᶜ := ext $ λ x, lt_or_lt_iff_ne

/-! #### 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, 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 [semilattice_inf α]

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

@[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 [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]

end sup

section both

variables [lattice α] {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]

end both
end lattice

section linear_order
variables [linear_order α] [linear_order β] {f : α → β} {a a₁ a₂ b b₁ b₂ c d : α}

@[simp] lemma Ioi_inter_Ioi : Ioi a ∩ Ioi b = Ioi (a ⊔ b) := ext $ λ _, sup_lt_iff.symm
@[simp] lemma Iio_inter_Iio : Iio a ∩ Iio b = Iio (a ⊓ b) := ext $ λ _, lt_inf_iff.symm

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

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 Ioc_inter_Ioi : 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]

@[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 [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

end set

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

section dense

variables (α) [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