import data.real.basic
import data.set.intervals.basic
import data.complex.exponential
import data.matrix.basic
import analysis.convex.basic

noncomputable theory
open_locale classical
open_locale convex
open_locale matrix

open set
open metric.metric_space

namespace fuzzy

-- Tactic example
example (A B C : Type) (h1: A → B) (h2 : B → C) : A → C :=
begin
  intro a,
  exact h2 (h1 a),
end

-- Fuzzy sets basic definitions
@[simp]
def fuzzy_set (u : Type) := u → Icc (0 : ℝ) 1

@[simp]
def mem {u : Type} (X : fuzzy_set u) (x : u) : ℝ := (X x).val

variable {u : Type}
variables (X Y : fuzzy_set u)

lemma mem_def_val : ∀ x, (X x).val = mem X x :=
begin
  intro x,
  dsimp,
  refl,
end

@[simp]
lemma mem_def : ∀ x, mem X x ∈ Icc (0:ℝ) 1 := λ x, (X x).2

lemma mem_pos : ∀ x, 0 ≤ mem X x := λ x, (X x).2.1
lemma mem_le_one : ∀ x, mem X x ≤ 1 := λ x, (X x).2.2

@[simp]
def support (X : fuzzy_set u) : set u := {x : u | (mem X x) > 0}
def support' : fuzzy_set u → set u := λ X,  {x : u | (mem X x) > 0}

def is_classical (X : fuzzy_set u) := ∀x,((mem X x)=0 ∨ (mem X x)=1)

@[simp]
def classical_to_fuzzy (X : set u) : fuzzy_set u := λ x, ite (x ∈ X) ⟨1,by simp⟩ ⟨0,by simp⟩
@[simp]
def fuzzy_to_classical (X : fuzzy_set u) /-(h : is_classical X)-/: set u := {x:u | (mem X x) = 1 }

def is_empty (X : fuzzy_set u) := ∀x, (mem X x)=0

example (X: fuzzy_set u) ( x : u) (h: is_empty X) : (mem X x)=0 :=
begin
  unfold is_empty at h,
  specialize h x,
  exact h,
end

lemma empty_is_classical (X : fuzzy_set u) : is_empty X → (is_classical X):=
begin
  intros emp x,
  left,
  specialize emp x,
  exact emp,
end

lemma fuzzy_nat_subset_is_cl (X: fuzzy_set ℕ ) (h1: ∀n, n ≤ 3 → (mem X n)=1) (h2 : ∀n, n > 3 → (mem X n)=0) : is_classical X :=
begin
  unfold is_classical,
  intros nn,
  specialize h1 nn,
  specialize h2 nn,
  cases le_or_lt nn 3 with hl3 hg3,
  right,
  apply h1,
  exact hl3,
  left,
  apply h2,
  exact hg3,
end

lemma fuzzy_natural_subset (X: fuzzy_set ℕ ) (h1: ∀n, n ≤ 3 → (mem X n)=1) (h2 : ∀n, n > 3 → (mem X n)=0) : fuzzy_to_classical X = {n : ℕ | n≤ 3}:=
begin
  unfold fuzzy_to_classical,
  ext,
  split,
  intro h,
  specialize h2 x,
  have H : mem X x = 1 → x ≤ 3,
  {contrapose!,
  intro Mem,
  --push_neg at Mem,
  have C:= h2 Mem,
  linarith,},
  rw mem_set_of_eq,
  rw mem_set_of_eq at h,
  apply H,
  exact h,

  intro h,
  rw mem_set_of_eq,
  rw mem_set_of_eq at h,
  specialize h1 x,
  apply h1,
  exact h,
end

-- Instances for notation and definition of lattice structure
-- We define here the inclusion, union, intersection and complement of fuzzy sets
instance {α : Type*} : has_subset (fuzzy_set α) := {subset := λ A B, (∀ x, A x ≤ B x) }
#check X⊆Y

@[simp]
instance {α : Type*} : has_sup (fuzzy_set α) := { sup := λ A B, (λ x, max (A x) (B x)) }
@[simp]
instance {α : Type*} : has_inf (fuzzy_set α) := { inf := λ A B, (λ x, min (A x) (B x)) }
@[simp]
instance {α : Type*} : has_compl (fuzzy_set α) := {compl := λ A, (λ x,⟨ 1 - (A x), by
begin
  split,
  rw sub_nonneg,
  have h1: (A x).val ≤ 1,{have := mem_def A x, cases this with f0 f1,exact f1,},
  exact h1,
  rw sub_le_self_iff,
  have h2: 0 ≤ (A x).val,{have := mem_pos A x, unfold mem at this, exact this,},
  exact h2,
end ⟩
)}
#check Xᶜ

instance is_lattice {α : Type*}: lattice (fuzzy_set α) :=
begin
apply lattice.mk',
{ intros a b, unfold has_sup.sup, simp [max_comm],},
{ intros a b c, unfold has_sup.sup, simp [max_assoc],},
{ intros a b, unfold has_inf.inf, simp [min_comm],},
{ intros a b c, unfold has_inf.inf, simp [min_assoc],},
{ intros a b, unfold has_sup.sup,  unfold has_inf.inf, ext,
  rw ←subtype.ext_iff, apply max_eq_left, apply min_le_left,},
{ intros a b, unfold has_sup.sup, unfold has_inf.inf, ext,
  rw ←subtype.ext_iff, apply min_eq_left, apply le_max_left,},
end

-- Structure extension so we have distributive property
instance is_distrib_lattice {α : Type*}: distrib_lattice (fuzzy_set α) :=
{ le_sup_inf :=
begin
  intros x y z,
  have h1: (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y ∧ (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ z,
  {split,
  exact inf_le_left,
  exact inf_le_right,},
  have h2 : y = y ⊓ z ∨  z = y ⊓ z,
  {by_cases h : y ≤ z,
  left,
  exact left_eq_inf.mpr h,
  right,
  have h' : z ≤ y, sorry,
  exact right_eq_inf.mpr h',},
  cases h2 with hy hz,
  calc (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y : by {exact inf_le_left}
  ... = x ⊔ y ⊓ z :  by {exact congr_arg (has_sup.sup x) hy},
  calc (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ z : by {exact inf_le_right}
  ... = x ⊔ y ⊓ z :  by {exact congr_arg (has_sup.sup x) hz},
end
..fuzzy.is_lattice}

-- Alernative definitions for intersection and union
def intersection (X Y : fuzzy_set u) : fuzzy_set u := λ x, ⟨ min (X x).val (Y x).val, by
begin
  split,
  have h1: (X x).val ≥ 0,{have := mem_def X x, cases this with f0 f1,exact f0,},
  have h2: (Y x).val ≥ 0,{have := mem_def Y x, cases this with f0 f1,exact f0,},
  exact le_min h1 h2,
  have h1: (X x).val ≤ 1,{have := mem_def X x, cases this with f0 f1,exact f1,},
  have h2: (Y x).val ≤ 1,{have := mem_def Y x, cases this with f0 f1,exact f1,},
  exact min_le_of_left_le h1,
end⟩

example (X Y : fuzzy_set u) (x : u) (h1 : mem X x ≤ 1/2) : mem (X ⊓ Y) x ≤ 1/2:=
begin
  calc mem (X ⊓ Y) x = (min (X x) (Y x)).val : by {simp[has_inf.inf]}
  ... ≤ mem X x : by simp
  ... ≤ 1/2 : by {exact h1},
end

example (X Y : fuzzy_set u) (Z = intersection X Y) (x : u) (h1 : mem X x ≤ 1/2) : mem Z x ≤ 1/2:=
begin
  have h2 : mem Z x = (min (X x) (Y x)),
 {rw H,
  simp only [intersection],
  unfold_coes,
  ring,},
  have : mem Z x ≤ mem X x,
  {rw h2,
  exact min_le_left ↑(X x) ↑(Y x)},
  calc mem Z x ≤ mem X x : by {exact this}
  ...≤ 1/2 : by linarith,
end

def equivalence (X Y : fuzzy_set u) := ∀x, (mem X x = mem Y x)
instance {α : Type*} : has_equiv (fuzzy_set α) := {equiv := λ A B, (∀ x, A x = B x) }

-- Some results from the operations of fuzzy sets
open fuzzy

lemma max_min (x y : ℝ ): 1 - max x y = min (1-x) (1-y):=
begin
  by_cases h : x ≤ y,
  simp[h],
  {have h' : y ≤  x, by linarith [h],
  simp [h']},
end

lemma min_max (x y : ℝ ): 1 - min x y = max (1-x) (1-y):=
begin
  by_cases h: x ≤ y,
  {simp [h]},
  {have h' : y ≤  x, by linarith [h],
  simp [h']},
end

@[simp]
lemma max_val_comm {u : Type}(A B : fuzzy_set u) (x : u) :  (max (A x) (B x)).val = max ↑(A x) ↑(B x) :=
begin
    by_cases h : A x ≤ B x,
  {
    simp [h],
  },
  {
    replace h : B x ≤ A x,
    {
      unfold has_le.le,
      unfold_coes,

      push_neg at h,
      unfold has_lt.lt at h,
      unfold_coes at h,
sorry,
      --nlinarith [h],
    },
    simp [h],
  }
end

theorem first_Morgan_law (A B : fuzzy_set u) :  (A ⊔ B)ᶜ = Aᶜ ⊓ Bᶜ  :=
begin
  ext,
  calc mem (A ⊔ B)ᶜ x = 1 - mem (A ⊔ B) x: by simp[has_compl.compl]
  ... = 1 - (max (A x) (B x)).val : by simp[has_sup.sup]
  ... = 1 - max ((A x)) (B x) : by {simp}
  ... = min (1 - A x) (1 - B x) : by {rw max_min}
  ... = min (Aᶜ x) (Bᶜ x) : by simp[has_compl.compl]
  ... = mem (Aᶜ ⊓ Bᶜ) x : by {simp[has_inf.inf],sorry},

end

theorem second_Morgan_law (A B : fuzzy_set u) : (A ⊓ B)ᶜ = Aᶜ ⊔ Bᶜ   :=
begin
  ext,
  calc mem (A ⊓ B)ᶜ x = 1 - mem (A ⊓ B) x : by simp[has_compl.compl]
  ... = 1 - min (A x) (B x) : by {simp[has_inf.inf],/-rw mem_def-/sorry}
  ... = max (1 - A x) (1 - B x) : by {rw min_max}
  ... = max (Aᶜ x) (Bᶜ x) : by simp[has_compl.compl]
  ... = mem (Aᶜ ⊔ Bᶜ) x : by {sorry},
end

theorem distr_int (A B C : fuzzy_set u) : C ⊔ (A ⊓ B) = (C ⊔ A) ⊓ (C ⊔ B):=
begin
  exact sup_inf_left,
 end

theorem distr_uni (A B C : fuzzy_set u) : C ⊓ (A ⊔ B) = (C ⊓ A) ⊔ (C ⊓ B):=
begin
  exact inf_sup_left,
end

theorem int_big (A B C: fuzzy_set u) (h1 : C ⊆ A) (h2 : C ⊆ B) : C ⊆ (A ⊓ B):=
begin
  intro x,
  calc mem C x ≤ (min (A x) (B x)).val : by {simp, split, exact h1 x,exact h2 x}
  ... = mem (A ⊓ B) x : by simp[has_inf.inf],

end

theorem uni_small (A B C: fuzzy_set u) (h1 : A ⊆ C) (h2 : B ⊆ C) : (A ⊔ B) ⊆ C:=
begin
  intro x,
  calc mem (A ⊔ B) x = (max (A x) (B x)).val : by simp[has_sup.sup]
  ... ≤ mem C x : by {simp,split,exact h1 x, exact h2 x},
end

-- ℱ

-- Fuzzy sets defined in ℝⁿ

variables {n : ℕ}
local notation `E` := fin n → ℝ -- definition of Rⁿ in Lean
#check (univ : set E)
#check (fin n)

example (X : fin 4 → ℝ ) (h2: (X 0) = 3) (h3: X 1 = 4) : X 0 + X 1 = 7:=
begin
  rw h2,rw h3,
  linarith,
end

def test3 : fuzzy_set (fin 3 → ℝ )  := λ x, ⟨ ((real.sin(x 0))^2+(real.sin(x 1))^2)/2 , by
begin
  split,
  nlinarith,
  have h1: ((real.sin(x 0))^2) ≤ 1,
  exact real.sin_sq_le_one (x 0),
  have h2: ((real.sin(x 1))^2) ≤ 1,
  exact real.sin_sq_le_one (x 1),
  calc (real.sin (x 0) ^ 2 + real.sin (x 1) ^ 2) / 2 ≤ (real.sin (x 0) ^ 2)/2 + (real.sin (x 1) ^ 2 )/2 : by linarith
  ...≤ 1/2 + 1/2 : by linarith[h1, h2]
  ... ≤ 1 : by linarith,
  --repeat {linarith},
end
⟩

example : has_dist.dist (1:ℝ) 2 = 1 :=
begin
  unfold dist,
  rw [show (1:ℝ)-2= - 1, by ring],
  simp,
end

example /-(𝕜 : Type)-/  : convex ℝ (Icc (0 : ℝ ) 1 : set ℝ )  :=
begin
  unfold convex,
  intros x y hx hy a b ha hb hab,
  cases hx,
  cases hy,
  split;
  {simp,
  nlinarith [ha, hb, hab],},
end

example {a b : ℝ} (x : Icc a b) : (x : ℝ) ≤ b :=
begin
rcases x with ⟨xv, ⟨x1, x2⟩⟩,
norm_num,
assumption,
end

example :  metric.bounded (Icc (0 : ℝ ) 1 : set ℝ )  :=
begin
  unfold metric.bounded,
  use 2,
  intros x hx y hy,
  unfold dist,
  unfold abs,
  simp,
  split;
  {linarith[hx.2,hx.1,hy.1,hy.2]},
end

-- Fuzzy convex and bounded sets, and separation theorems
@[simp]
def cla (X: fuzzy_set u) (α : ℝ) : set u := {x:u | (mem X x) > α }

@[simp]
def fuzzy_convex (A : fuzzy_set E) := ∀α, convex ℝ  (cla A α : set E)
@[simp]
def fuzzy_bounded (A : fuzzy_set E) := ∀α, metric.bounded (cla A α : set E)

#check (⬝ᵥ) --dot product
@[simp]
def hyperplane (v : E) (c : ℝ) : set E := { x : E | (x ⬝ᵥ v) = c}
def pos_hyperplane (v : E) (c : ℝ) : set E := { x : E | (x ⬝ᵥ v) ≥ c}
def neg_hyperplane (v : E) (c : ℝ) : set E := { x : E | (x ⬝ᵥ v) ≤ c}

theorem hyperplane_sep_classic (A B : set E) (h1: convex ℝ (A : set E) ∧ convex ℝ (B : set E) )
(h2: disjoint A B) : ∃ (v : E) (c :ℝ ), ∀ a ∈ A, ∀ b∈ B,  (a ⬝ᵥ v) ≥ c ∧ (b ⬝ᵥ v) ≤  c:=
begin
  sorry,
end

-- Supremum of the image of a fuzzy set
def fuzzy_sup (A : fuzzy_set u) := (Sup (range (mem A)) : ℝ )

theorem hyperplane_sep_fuzzy (A B : fuzzy_set E) (h1 : fuzzy_convex A ∧ fuzzy_convex B)
(h2 : fuzzy_bounded A ∧ fuzzy_bounded B) :
(∃ (v : E) (c :ℝ ),  fuzzy_sup (A⊓B) = max (fuzzy_sup (A ⊓ (classical_to_fuzzy (pos_hyperplane v c))))
 (fuzzy_sup (B⊓(classical_to_fuzzy (neg_hyperplane v c))))) ∧
(∀ (v : E) (c :ℝ ), fuzzy_sup (A⊓B) ≤ max (fuzzy_sup (A ⊓ (classical_to_fuzzy (pos_hyperplane v c))))
 (fuzzy_sup (B⊓(classical_to_fuzzy (neg_hyperplane v c))))):=
begin
  sorry,
end

end fuzzy


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudriashov
-/
import analysis.convex.jensen
import analysis.normed_space.finite_dimension
import analysis.normed_space.ray
import topology.path_connected
import topology.algebra.affine

/-!
# Topological and metric properties of convex sets

We prove the following facts:

* `convex.interior` : interior of a convex set is convex;
* `convex.closure` : closure of a convex set is convex;
* `set.finite.compact_convex_hull` : convex hull of a finite set is compact;
* `set.finite.is_closed_convex_hull` : convex hull of a finite set is closed;
* `convex_on_dist` : distance to a fixed point is convex on any convex set;
* `convex_hull_ediam`, `convex_hull_diam` : convex hull of a set has the same (e)metric diameter
  as the original set;
* `bounded_convex_hull` : convex hull of a set is bounded if and only if the original set
  is bounded.
* `bounded_std_simplex`, `is_closed_std_simplex`, `compact_std_simplex`: topological properties
  of the standard simplex;
-/

variables {ι : Type*} {E : Type*}

open set
open_locale pointwise convex

lemma real.convex_iff_is_preconnected {s : set ℝ} : convex ℝ s ↔ is_preconnected s :=
convex_iff_ord_connected.trans is_preconnected_iff_ord_connected.symm

alias real.convex_iff_is_preconnected ↔ convex.is_preconnected is_preconnected.convex

/-! ### Standard simplex -/

section std_simplex

variables [fintype ι]

/-- Every vector in `std_simplex 𝕜 ι` has `max`-norm at most `1`. -/
lemma std_simplex_subset_closed_ball :
  std_simplex ℝ ι ⊆ metric.closed_ball 0 1 :=
begin
  assume f hf,
  rw [metric.mem_closed_ball, dist_zero_right],
  refine (nnreal.coe_one ▸ nnreal.coe_le_coe.2 $ finset.sup_le $ λ x hx, _),
  change |f x| ≤ 1,
  rw [abs_of_nonneg $ hf.1 x],
  exact (mem_Icc_of_mem_std_simplex hf x).2
end

variable (ι)

/-- `std_simplex ℝ ι` is bounded. -/
lemma bounded_std_simplex : metric.bounded (std_simplex ℝ ι) :=
(metric.bounded_iff_subset_ball 0).2 ⟨1, std_simplex_subset_closed_ball⟩

/-- `std_simplex ℝ ι` is closed. -/
lemma is_closed_std_simplex : is_closed (std_simplex ℝ ι) :=
(std_simplex_eq_inter ℝ ι).symm ▸ is_closed.inter
  (is_closed_Inter $ λ i, is_closed_le continuous_const (continuous_apply i))
  (is_closed_eq (continuous_finset_sum _ $ λ x _, continuous_apply x) continuous_const)

/-- `std_simplex ℝ ι` is compact. -/
lemma compact_std_simplex : is_compact (std_simplex ℝ ι) :=
metric.compact_iff_closed_bounded.2 ⟨is_closed_std_simplex ι, bounded_std_simplex ι⟩

end std_simplex

/-! ### Topological vector space -/

section has_continuous_const_smul

variables [add_comm_group E] [module ℝ E] [topological_space E]
  [topological_add_group E] [has_continuous_const_smul ℝ E]

lemma convex.combo_interior_self_subset_interior {s : set E} (hs : convex ℝ s) {a b : ℝ}
  (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • interior s + b • s ⊆ interior s :=
interior_smul₀ ha.ne' s ▸
  calc interior (a • s) + b • s ⊆ interior (a • s + b • s) : subset_interior_add_left
  ... ⊆ interior s : interior_mono $ hs.set_combo_subset ha.le hb hab

lemma convex.combo_self_interior_subset_interior {s : set E} (hs : convex ℝ s) {a b : ℝ}
  (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
  a • s + b • interior s ⊆ interior s :=
by { rw add_comm, exact hs.combo_interior_self_subset_interior hb ha (add_comm a b ▸ hab) }

lemma convex.combo_mem_interior_left {s : set E} (hs : convex ℝ s) {x y : E} (hx : x ∈ interior s)
  (hy : y ∈ s) {a b : ℝ} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • x + b • y ∈ interior s :=
hs.combo_interior_self_subset_interior ha hb hab $
  add_mem_add (smul_mem_smul_set hx) (smul_mem_smul_set hy)

lemma convex.combo_mem_interior_right {s : set E} (hs : convex ℝ s) {x y : E} (hx : x ∈ s)
  (hy : y ∈ interior s) {a b : ℝ} (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
  a • x + b • y ∈ interior s :=
hs.combo_self_interior_subset_interior ha hb hab $
  add_mem_add (smul_mem_smul_set hx) (smul_mem_smul_set hy)

lemma convex.open_segment_subset_interior_left {s : set E} (hs : convex ℝ s) {x y : E}
  (hx : x ∈ interior s) (hy : y ∈ s) : open_segment ℝ x y ⊆ interior s :=
by { rintro _ ⟨a, b, ha, hb, hab, rfl⟩, exact hs.combo_mem_interior_left hx hy ha hb.le hab }

lemma convex.open_segment_subset_interior_right {s : set E} (hs : convex ℝ s) {x y : E}
  (hx : x ∈ s) (hy : y ∈ interior s) : open_segment ℝ x y ⊆ interior s :=
by { rintro _ ⟨a, b, ha, hb, hab, rfl⟩, exact hs.combo_mem_interior_right hx hy ha.le hb hab }

/-- If `x ∈ s` and `y ∈ interior s`, then the segment `(x, y]` is included in `interior s`. -/
lemma convex.add_smul_sub_mem_interior {s : set E} (hs : convex ℝ s)
  {x y : E} (hx : x ∈ s) (hy : y ∈ interior s) {t : ℝ} (ht : t ∈ Ioc (0 : ℝ) 1) :
  x + t • (y - x) ∈ interior s :=
by simpa only [sub_smul, smul_sub, one_smul, add_sub, add_comm]
  using hs.combo_mem_interior_left hy hx ht.1 (sub_nonneg.mpr ht.2) (add_sub_cancel'_right _ _)

/-- If `x ∈ s` and `x + y ∈ interior s`, then `x + t y ∈ interior s` for `t ∈ (0, 1]`. -/
lemma convex.add_smul_mem_interior {s : set E} (hs : convex ℝ s)
  {x y : E} (hx : x ∈ s) (hy : x + y ∈ interior s) {t : ℝ} (ht : t ∈ Ioc (0 : ℝ) 1) :
  x + t • y ∈ interior s :=
by { convert hs.add_smul_sub_mem_interior hx hy ht, abel }

/-- In a topological vector space, the interior of a convex set is convex. -/
lemma convex.interior {s : set E} (hs : convex ℝ s) : convex ℝ (interior s) :=
convex_iff_open_segment_subset.mpr $ λ x y hx hy,
  hs.open_segment_subset_interior_left hx (interior_subset hy)

/-- In a topological vector space, the closure of a convex set is convex. -/
lemma convex.closure {s : set E} (hs : convex ℝ s) : convex ℝ (closure s) :=
λ x y hx hy a b ha hb hab,
let f : E → E → E := λ x' y', a • x' + b • y' in
have hf : continuous (λ p : E × E, f p.1 p.2), from
  (continuous_fst.const_smul _).add (continuous_snd.const_smul _),
show f x y ∈ closure s, from
  mem_closure_of_continuous2 hf hx hy (λ x' hx' y' hy', subset_closure
  (hs hx' hy' ha hb hab))

end has_continuous_const_smul

section has_continuous_smul

variables [add_comm_group E] [module ℝ E] [topological_space E]
  [topological_add_group E] [has_continuous_smul ℝ E]

/-- Convex hull of a finite set is compact. -/
lemma set.finite.compact_convex_hull {s : set E} (hs : finite s) :
  is_compact (convex_hull ℝ s) :=
begin
  rw [hs.convex_hull_eq_image],
  apply (compact_std_simplex _).image,
  haveI := hs.fintype,
  apply linear_map.continuous_on_pi
end

/-- Convex hull of a finite set is closed. -/
lemma set.finite.is_closed_convex_hull [t2_space E] {s : set E} (hs : finite s) :
  is_closed (convex_hull ℝ s) :=
hs.compact_convex_hull.is_closed

open affine_map

/-- If we dilate a convex set about a point in its interior by a scale `t > 1`, the interior of
the result contains the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
lemma convex.subset_interior_image_homothety_of_one_lt
  {s : set E} (hs : convex ℝ s) {x : E} (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) :
  s ⊆ interior (image (homothety x t) s) :=
begin
  intros y hy,
  let I := { z | ∃ (u : ℝ), u ∈ Ioc (0 : ℝ) 1 ∧ z = y + u • (x - y) },
  have hI : I ⊆ interior s,
  { rintros z ⟨u, hu, rfl⟩, exact hs.add_smul_sub_mem_interior hy hx hu, },
  let z := homothety x t⁻¹ y,
  have hz₁ : z ∈ interior s,
  { suffices : z ∈ I, { exact hI this, },
    use 1 - t⁻¹,
    split,
    { simp only [mem_Ioc, sub_le_self_iff, inv_nonneg, sub_pos, inv_lt_one ht, true_and],
      linarith, },
    { simp only [z, homothety_apply, sub_smul, smul_sub, vsub_eq_sub, vadd_eq_add, one_smul],
      abel, }, },
  have ht' : t ≠ 0, { linarith, },
  have hz₂ : y = homothety x t z, { simp [z, ht', homothety_apply, smul_smul], },
  rw hz₂,
  rw mem_interior at hz₁ ⊢,
  obtain ⟨U, hU₁, hU₂, hU₃⟩ := hz₁,
  exact ⟨image (homothety x t) U,
         image_subset ⇑(homothety x t) hU₁,
         homothety_is_open_map x t ht' U hU₂,
         mem_image_of_mem ⇑(homothety x t) hU₃⟩,
end

lemma convex.is_path_connected {s : set E} (hconv : convex ℝ s) (hne : s.nonempty) :
  is_path_connected s :=
begin
  refine is_path_connected_iff.mpr ⟨hne, _⟩,
  intros x x_in y y_in,
  have H := hconv.segment_subset x_in y_in,
  rw segment_eq_image_line_map at H,
  exact joined_in.of_line affine_map.line_map_continuous.continuous_on (line_map_apply_zero _ _)
    (line_map_apply_one _ _) H
end

/--
Every topological vector space over ℝ is path connected.

Not an instance, because it creates enormous TC subproblems (turn on `pp.all`).
-/
lemma topological_add_group.path_connected : path_connected_space E :=
path_connected_space_iff_univ.mpr $ convex_univ.is_path_connected ⟨(0 : E), trivial⟩

end has_continuous_smul

/-! ### Normed vector space -/

section normed_space
variables [normed_group E] [normed_space ℝ E]

lemma convex_on_dist (z : E) (s : set E) (hs : convex ℝ s) :
  convex_on ℝ s (λz', dist z' z) :=
and.intro hs $
assume x y hx hy a b ha hb hab,
calc
  dist (a • x + b • y) z = ∥ (a • x + b • y) - (a + b) • z ∥ :
    by rw [hab, one_smul, normed_group.dist_eq]
  ... = ∥a • (x - z) + b • (y - z)∥ :
    by rw [add_smul, smul_sub, smul_sub, sub_eq_add_neg, sub_eq_add_neg, sub_eq_add_neg, neg_add,
           ←add_assoc, add_assoc (a • x), add_comm (b • y)]; simp only [add_assoc]
  ... ≤ ∥a • (x - z)∥ + ∥b • (y - z)∥ :
    norm_add_le (a • (x - z)) (b • (y - z))
  ... = a * dist x z + b * dist y z :
    by simp [norm_smul, normed_group.dist_eq, real.norm_eq_abs, abs_of_nonneg ha, abs_of_nonneg hb]

lemma convex_ball (a : E) (r : ℝ) : convex ℝ (metric.ball a r) :=
by simpa only [metric.ball, sep_univ] using (convex_on_dist a _ convex_univ).convex_lt r

lemma convex_closed_ball (a : E) (r : ℝ) : convex ℝ (metric.closed_ball a r) :=
by simpa only [metric.closed_ball, sep_univ] using (convex_on_dist a _ convex_univ).convex_le r

/-- Given a point `x` in the convex hull of `s` and a point `y`, there exists a point
of `s` at distance at least `dist x y` from `y`. -/
lemma convex_hull_exists_dist_ge {s : set E} {x : E} (hx : x ∈ convex_hull ℝ s) (y : E) :
  ∃ x' ∈ s, dist x y ≤ dist x' y :=
(convex_on_dist y _ (convex_convex_hull ℝ _)).exists_ge_of_mem_convex_hull hx

/-- Given a point `x` in the convex hull of `s` and a point `y` in the convex hull of `t`,
there exist points `x' ∈ s` and `y' ∈ t` at distance at least `dist x y`. -/
lemma convex_hull_exists_dist_ge2 {s t : set E} {x y : E}
  (hx : x ∈ convex_hull ℝ s) (hy : y ∈ convex_hull ℝ t) :
  ∃ (x' ∈ s) (y' ∈ t), dist x y ≤ dist x' y' :=
begin
  rcases convex_hull_exists_dist_ge hx y with ⟨x', hx', Hx'⟩,
  rcases convex_hull_exists_dist_ge hy x' with ⟨y', hy', Hy'⟩,
  use [x', hx', y', hy'],
  exact le_trans Hx' (dist_comm y x' ▸ dist_comm y' x' ▸ Hy')
end

/-- Emetric diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] lemma convex_hull_ediam (s : set E) :
  emetric.diam (convex_hull ℝ s) = emetric.diam s :=
begin
  refine (emetric.diam_le $ λ x hx y hy, _).antisymm (emetric.diam_mono $ subset_convex_hull ℝ s),
  rcases convex_hull_exists_dist_ge2 hx hy with ⟨x', hx', y', hy', H⟩,
  rw edist_dist,
  apply le_trans (ennreal.of_real_le_of_real H),
  rw ← edist_dist,
  exact emetric.edist_le_diam_of_mem hx' hy'
end

/-- Diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] lemma convex_hull_diam (s : set E) :
  metric.diam (convex_hull ℝ s) = metric.diam s :=
by simp only [metric.diam, convex_hull_ediam]

/-- Convex hull of `s` is bounded if and only if `s` is bounded. -/
@[simp] lemma bounded_convex_hull {s : set E} :
  metric.bounded (convex_hull ℝ s) ↔ metric.bounded s :=
by simp only [metric.bounded_iff_ediam_ne_top, convex_hull_ediam]

@[priority 100]
instance normed_space.path_connected : path_connected_space E :=
topological_add_group.path_connected

@[priority 100]
instance normed_space.loc_path_connected : loc_path_connected_space E :=
loc_path_connected_of_bases (λ x, metric.nhds_basis_ball)
  (λ x r r_pos, (convex_ball x r).is_path_connected $ by simp [r_pos])

lemma dist_add_dist_of_mem_segment {x y z : E} (h : y ∈ [x -[ℝ] z]) :
  dist x y + dist y z = dist x z :=
begin
  simp only [dist_eq_norm, mem_segment_iff_same_ray] at *,
  simpa only [sub_add_sub_cancel', norm_sub_rev] using h.norm_add.symm
end

end normed_space


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import tactic
import order.zorn

universe u

variables {P : Type u}

section
variables (P)

inductive proposition : Type u
| primitive : P → proposition
| false : proposition
| implication : proposition → proposition → proposition

end

instance : has_bot (proposition P) := ⟨proposition.false⟩
local infix ⇒:80 := proposition.implication
local notation `¬'`:90 p:90 := p ⇒ ⊥

section
variables (P)

structure valuation :=
(to_fun : proposition P → bool)
(to_fun_false : to_fun ⊥ = ff)
(to_fun_implication : ∀ {p q}, to_fun (p ⇒ q) = if to_fun p = tt ∧ to_fun q = ff then ff else tt)

instance : has_coe_to_fun (valuation P) (λ _, proposition P → bool) := ⟨valuation.to_fun⟩

end

namespace valuation

@[simp]
lemma apply_false (v : valuation P) : v proposition.false = ff :=
valuation.to_fun_false _

@[simp]
lemma apply_bot (v : valuation P) : v ⊥ = ff :=
valuation.to_fun_false _

section
variables (v : valuation P) (p q : proposition P)

lemma apply_implication : v (p ⇒ q) = if v p = tt ∧ v q = ff then ff else tt :=
valuation.to_fun_implication _

lemma apply_implication_eq_true_left (h : v p = ff) : v (p ⇒ q) = tt :=
by { rw apply_implication, finish }

lemma apply_implication_eq_true_right (h : v q = tt) : v (p ⇒ q) = tt :=
by { rw apply_implication, finish }

lemma apply_implication_eq_false (h₁ : v p = tt) (h₂ : v q = ff) : v (p ⇒ q) = ff :=
by { rw apply_implication, finish }

@[simp]
lemma apply_not (v : valuation P) (p : proposition P) : v (¬'p) = !v p :=
begin
  simp only [apply_implication, apply_bot, bnot, apply_bot, and_true, eq_self_iff_true],
  by_cases v p = tt,
  { simp [h] },
  { simp [h], simp at h, simp [h]  }
end

end

section
local attribute [ext] valuation

lemma ext'' {v v' : valuation P} (h : (v : proposition P → bool) = v') : v = v' :=
by { ext, exact congr_fun h _ }

local attribute [ext] ext''

@[ext]
lemma ext' {v v' : valuation P} (h : ∀ p, v (proposition.primitive p) = v' (proposition.primitive p)) :
  v = v' :=
begin
  ext,
  induction x,
  { exact h _ },
  { simp only [apply_false] },
  { simp [apply_implication, *] }
end

end

def extension_fun (w : P → bool) : proposition P → bool
| (proposition.primitive p) := w p
| ⊥ := ff
| (p ⇒ q) := if extension_fun p = tt ∧ extension_fun q = ff then ff else tt

def extension (w : P → bool) : valuation P :=
{ to_fun := extension_fun w,
  to_fun_false := by simp only [extension_fun],
  to_fun_implication := by simp only [extension_fun, forall_2_true_iff, eq_self_iff_true] }

@[simp]
lemma extension_primitive (w : P → bool) (p : P) : (extension w) (proposition.primitive p) = w p :=
rfl

end valuation

def semantically_entails (S : set (proposition P)) (p : proposition P) : Prop :=
∀ (v : valuation P), (∀ s ∈ S, v s = tt) → v p = tt

notation S ` ⊨ `:70 p:70 := semantically_entails S p

def tautology (p : proposition P) : Prop :=
∅ ⊨ p

notation `⊨ `:62 p:62 := tautology p

lemma tautology_iff (p : proposition P) : ⊨ p ↔ ∀ (v : valuation P), v p = tt :=
by { rw [tautology, semantically_entails], finish }

def axiom₁ (p q : proposition P) : proposition P := p ⇒ (q ⇒ p)
def axiom₂ (p q r : proposition P) : proposition P := (p ⇒ (q ⇒ r)) ⇒ ((p ⇒ q) ⇒ (p ⇒ r))
def axiom₃ (p : proposition P) : proposition P := (¬'¬'p) ⇒ p

lemma tautology_axiom₁ {p q : proposition P} : ⊨ axiom₁ p q :=
by { intro v, simp only [axiom₁, valuation.apply_implication], finish }
lemma tautology_axiom₂ {p q r : proposition P} : ⊨ axiom₂ p q r :=
by { intro v, simp only [axiom₂, valuation.apply_implication], finish }
lemma tautology_axiom₃ {p : proposition P} : ⊨ axiom₃ p :=
by { intro v, simp only [axiom₃, valuation.apply_implication], finish }

inductive proves (S : set (proposition P)) : proposition P → Prop
| ax₁ {p q : proposition P} : proves (axiom₁ p q)
| ax₂ {p q r : proposition P} : proves (axiom₂ p q r)
| ax₃ {p : proposition P} : proves (axiom₃ p)
| hypothesis {p : proposition P} (h : p ∈ S) : proves p
| modus_ponens {p q : proposition P} : proves (p ⇒ q) → proves p → proves q

notation S ` ⊢ `:70 p:70 := proves S p

namespace proves

lemma subset {S T : set (proposition P)} (hST : S ⊆ T) {p : proposition P} (h : S ⊢ p) : T ⊢ p :=
by { induction h, exacts [ax₁, ax₂, ax₃, hypothesis (hST (by assumption)), modus_ponens (by assumption) (by assumption)] }

end proves

def is_theorem (p : proposition P) : Prop :=
proves ∅ p

notation `⊢ `:70 p:70 := is_theorem p

section
open proves

lemma implies_self {p : proposition P} : ⊢ p ⇒ p :=
have h1 : ⊢ (p ⇒ ((p ⇒ p) ⇒ p)) ⇒ ((p ⇒ (p ⇒ p)) ⇒ (p ⇒ p)), from ax₂,
have h2 : ⊢ p ⇒ ((p ⇒ p) ⇒ p),                               from ax₁,
have h3 : ⊢ (p ⇒ (p ⇒ p)) ⇒ (p ⇒ p),                         from modus_ponens h1 h2,
have h4 : ⊢ p ⇒ (p ⇒ p),                                     from ax₁,
show      ⊢ p ⇒ p,                                           from modus_ponens h3 h4

end

section deduction_theorem
open proves

theorem deduction (S : set (proposition P)) (p q : proposition P) : S ⊢ p ⇒ q ↔ (S ∪ {p}) ⊢ q :=
begin
  refine ⟨λ h, modus_ponens (subset (by simp) h) $ hypothesis $ by simp, λ h, _⟩,
  induction h with _ _ _ _ _ _ _ hpS _ _ _ _ π₁ π₂,
  { exact modus_ponens ax₁ ax₁ },
  { exact modus_ponens ax₁ ax₂ },
  { exact modus_ponens ax₁ ax₃ },
  { cases (set.mem_union _ _ _).1 hpS,
    { exact modus_ponens ax₁  (hypothesis h) },
    { rw set.mem_singleton_iff.1 h,
      exact subset (set.empty_subset _) implies_self } },
  { exact modus_ponens (modus_ponens ax₂ π₁) π₂ }
end

lemma deduction_single {p q : proposition P} : ⊢ p ⇒ q ↔ {p} ⊢ q :=
by { convert deduction ∅ p q, rw set.empty_union }

end deduction_theorem

section soundness_theorem
open proves

theorem soundness (S : set (proposition P)) (p : proposition P) (h : S ⊢ p) : S ⊨ p :=
begin
  intros v hv,
  induction h,
  { exact (tautology_iff _).1 tautology_axiom₁ _ },
  { exact (tautology_iff _).1 tautology_axiom₂ _ },
  { exact (tautology_iff _).1 tautology_axiom₃ _ },
  { exact hv _ h_h },
  { rw [valuation.apply_implication] at *,
    finish }
end

end soundness_theorem

def consistent (S : set (proposition P)) : Prop :=
¬(S ⊢ ⊥)

lemma consistent_or_consistent_not {S : set (proposition P)} (hS : consistent S) (p : proposition P) :
  consistent (S ∪ {p}) ∨ consistent (S ∪ {¬'p}) :=
begin
  contrapose! hS,
  simp only [consistent, not_not, ←deduction] at *,
  exact proves.modus_ponens hS.2 hS.1
end

lemma exists_deductive_closure (S : set (proposition P)) (hS : consistent S) :
  ∃ (S' : set (proposition P)), S ⊆ S' ∧ consistent S' ∧ (∀ p, S' ⊢ p → p ∈ S') ∧ (∀ p, p ∈ S' ∨ ¬'p ∈ S') :=
begin
  let T := { S' : set (proposition P) | S ⊆ S' ∧ consistent S' },
  suffices hS' : ∃ S' ∈ T, S ⊆ S' ∧ ∀ S'' ∈ T, S' ⊆ S'' → S'' = S',
  { rcases hS' with ⟨S', ⟨hS'₁, hS'₂⟩, hS'₃, hS'₄⟩,
    have hS : ∀ p, p ∈ S' ∨ ¬'p ∈ S',
    { intro p,
      cases consistent_or_consistent_not hS'₂ p,
      { suffices : S' ∪ {p} = S',
        { rw ←this, left, simp only [set.mem_insert_iff, true_or, eq_self_iff_true, set.union_singleton] },
        exact hS'₄ _ ⟨set.subset_union_of_subset_left hS'₃ _, h⟩ (set.subset_union_left _ _) },
      { suffices : S' ∪ {¬'p} = S',
        { rw ←this, right, simp only [set.mem_insert_iff, true_or, eq_self_iff_true, and_self, set.union_singleton] },
        exact hS'₄ _ ⟨set.subset_union_of_subset_left hS'₃ _, h⟩ (set.subset_union_left _ _) } },
    refine ⟨S', ⟨hS'₃, hS'₂, λ p hp, _, hS⟩⟩,
    { cases hS p,
      { exact h },
      { exact false.elim (hS'₂ (proves.modus_ponens (proves.hypothesis h) hp)) } } },
  refine zorn.zorn_subset_nonempty _ (λ c hcT hc hc', ⟨set.sUnion c, ⟨⟨_, _⟩, λ S' hS', _⟩⟩) _ ⟨set.subset.refl _, hS⟩,
  { rcases hc' with ⟨c₀, hc₀⟩,
    exact set.subset_sUnion_of_subset _ _ (hcT hc₀).1 hc₀ },
  { rw [consistent],
    by_contradiction,
    suffices : ∃ S₀ ∈ c, S₀ ⊢ ⊥,
    { rcases this with ⟨S₀, hS₀, hS₀'⟩,
      exact (hcT hS₀).2 hS₀' },
    rcases hc' with ⟨c₀, hc₀⟩,
    induction h with _ _ _ _ _ _ p hp p q hpq hp hc₁ hc₂,
    { exact ⟨c₀, hc₀, proves.ax₁⟩ },
    { exact ⟨c₀, hc₀, proves.ax₂⟩ },
    { exact ⟨c₀, hc₀, proves.ax₃⟩ },
    { obtain ⟨c₁, ⟨hc₁c, hpc₁⟩⟩ := set.mem_sUnion.1 hp,
      exact ⟨c₁, hc₁c, proves.hypothesis hpc₁⟩ },
    { obtain ⟨c₁, ⟨hc₁c, hc₁pq⟩⟩ := hc₁,
      obtain ⟨c₂, ⟨hc₂c, hc₂p⟩⟩ := hc₂,
      refine ⟨c₁ ∪ c₂, _, _⟩,
      { cases zorn.chain.total_of_refl hc hc₁c hc₂c,
        { convert hc₂c,
          exact set.union_eq_right_iff_subset.2 h },
        { convert hc₁c,
          exact set.union_eq_left_iff_subset.2 h } },
      { exact proves.modus_ponens (proves.subset (set.subset_union_left _ _) hc₁pq) (proves.subset (set.subset_union_right _ _) hc₂p) } } },
  { exact set.subset_sUnion_of_mem hS' }
end

section
open proves

lemma false_elimination_tautology {p : proposition P} : ⊢ ⊥ ⇒ p :=
deduction_single.2 $ modus_ponens ax₃ $ deduction_single.1 ax₁

lemma false_elimination {S : set (proposition P)} {p : proposition P} : S ⊢ ⊥ ⇒ p :=
proves.subset (set.empty_subset _) false_elimination_tautology

end

theorem model_existence (S : set (proposition P)) (hS : consistent S) :
  ∃ (v : valuation P), ∀ s ∈ S, v s = tt :=
begin
  obtain ⟨S', ⟨hSS', hS'₁, hS'₂, hS'₃⟩⟩ := exists_deductive_closure S hS,
  classical,
  refine ⟨⟨λ p, if p ∈ S' then tt else ff, _, _⟩, _⟩,
  { simp only [if_false_left_eq_and, and_true, eq_self_iff_true, ite_eq_ff_distrib],
    simp only [consistent] at hS'₁,
    contrapose! hS'₁,
    exact proves.hypothesis hS'₁ },
  { intros p q,
    by_cases h₁ : p ∈ S',
    { by_cases h₂ : q ∈ S',
      { simp only [*, and_true, eq_self_iff_true, ite_eq_right_iff, if_false, forall_true_left, if_false_right_eq_and, ite_eq_tt_distrib,
          and_false],
        exact hS'₂ _ (proves.modus_ponens proves.ax₁ (proves.hypothesis h₂)) },
      { simp only [*, forall_false_left, if_false_left_eq_and, and_true, if_true, eq_self_iff_true, not_true, ite_eq_right_iff, and_self,
          ite_eq_ff_distrib, ite_eq_left_iff, not_false_iff],
          refine λ h₃, h₂ (hS'₂ _ (proves.modus_ponens (proves.hypothesis h₃) (proves.hypothesis h₁))) } },
    { simp only [*, and_true, eq_self_iff_true, if_false, if_false_right_eq_and, ite_eq_tt_distrib, false_and],
      have h₂ : ¬'p ∈ S',
      { cases hS'₃ p,
        { exact false.elim (h₁ h) },
        { exact h } },
      refine hS'₂ _ _,
      rw deduction,
      refine proves.modus_ponens false_elimination
        (proves.modus_ponens (proves.subset (set.subset_union_left _ _) (proves.hypothesis h₂)) (proves.hypothesis _)),
      simp only [set.mem_insert_iff, true_or, eq_self_iff_true, set.union_singleton] } },
  { intros s hs,
    change ite (s ∈ S') tt ff = tt,
    simp only [and_true, eq_self_iff_true, if_false_right_eq_and, ite_eq_tt_distrib],
    exact hSS' hs },
end

lemma model_existence' (S : set (proposition P)) (h : S ⊨ ⊥) : S ⊢ ⊥ :=
begin
  by_contradiction h',
  obtain ⟨v, hv⟩ := model_existence _ h',
  simpa only [valuation.apply_bot] using h v hv
end

theorem adequacy (S : set (proposition P)) (p : proposition P) (h : S ⊨ p) : S ⊢ p :=
begin
  have : S ∪ {¬'p} ⊨ ⊥,
  { intros v hv,
    have h₁ := h v (λ p hp, hv _ (set.mem_union_left _ hp)),
    have h₂ := hv (¬'p) (set.mem_union_right _ (set.mem_singleton _)),
    rw valuation.apply_not at h₂,
    finish },
  replace this := model_existence' _ this,
  rw ←deduction at this,
  exact proves.modus_ponens proves.ax₃ this
end

theorem completeness (S : set (proposition P)) (p : proposition P) : S ⊨ p ↔ S ⊢ p :=
⟨adequacy _ _, soundness _ _⟩

theorem compactness (S : set (proposition P)) (p : proposition P) (h : S ⊨ p) : ∃ S' ⊆ S, S'.finite ∧ S' ⊨ p :=
begin
  simp only [completeness] at ⊢ h,
  induction h with _ _ _ _ _ _ q hq q r hqr hq hS₁ hS₂,
  { exact ⟨∅, set.empty_subset _, set.finite_empty, proves.ax₁⟩ },
  { exact ⟨∅, set.empty_subset _, set.finite_empty, proves.ax₂⟩ },
  { exact ⟨∅, set.empty_subset _, set.finite_empty, proves.ax₃⟩ },
  { refine ⟨{q}, set.singleton_subset_iff.2 hq, set.finite_singleton _, proves.hypothesis (set.mem_singleton _)⟩ },
  { rcases hS₁ with ⟨S₁, hS₁S, hS₁, hS₁qr⟩,
    rcases hS₂ with ⟨S₂, hS₂S, hS₂, hS₂q⟩,
    refine ⟨S₁ ∪ S₂, set.union_subset hS₁S hS₂S, set.finite.union hS₁ hS₂, _⟩,
    exact proves.modus_ponens (proves.subset (set.subset_union_left _ _) hS₁qr) (proves.subset (set.subset_union_right _ _) hS₂q) }
end


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

This file is to a certain extent based on `quotient_module.lean` by Johannes Hölzl.
-/
import group_theory.coset
import group_theory.congruence

/-!
# Quotients of groups by normal subgroups

This files develops the basic theory of quotients of groups by normal subgroups. In particular it
proves Noether's first and second isomorphism theorems.

## Main definitions

* `mk'`: the canonical group homomorphism `G →* G/N` given a normal subgroup `N` of `G`.
* `lift φ`: the group homomorphism `G/N →* H` given a group homomorphism `φ : G →* H` such that
  `N ⊆ ker φ`.
* `map f`: the group homomorphism `G/N →* H/M` given a group homomorphism `f : G →* H` such that
  `N ⊆ f⁻¹(M)`.

## Main statements

* `quotient_ker_equiv_range`: Noether's first isomorphism theorem, an explicit isomorphism
  `G/ker φ → range φ` for every group homomorphism `φ : G →* H`.
* `quotient_inf_equiv_prod_normal_quotient`: Noether's second isomorphism theorem, an explicit
  isomorphism between `H/(H ∩ N)` and `(HN)/N` given a subgroup `H` and a normal subgroup `N` of a
  group `G`.
* `quotient_group.quotient_quotient_equiv_quotient`: Noether's third isomorphism theorem,
  the canonical isomorphism between `(G / N) / (M / N)` and `G / M`, where `N ≤ M`.

## Tags

isomorphism theorems, quotient groups
-/

universes u v

namespace quotient_group

variables {G : Type u} [group G] (N : subgroup G) [nN : N.normal] {H : Type v} [group H]
include nN

/-- The congruence relation generated by a normal subgroup. -/
@[to_additive "The additive congruence relation generated by a normal additive subgroup."]
protected def con : con G :=
{ to_setoid := left_rel N,
  mul' := λ a b c d (hab : a⁻¹ * b ∈ N) (hcd : c⁻¹ * d ∈ N),
    calc (a * c)⁻¹ * (b * d) = c⁻¹ * (a⁻¹ * b) * c⁻¹⁻¹ * (c⁻¹ * d) :
      by simp only [mul_inv_rev, mul_assoc, inv_mul_cancel_left]
    ... ∈ N : N.mul_mem (nN.conj_mem _ hab _) hcd }

@[to_additive quotient_add_group.add_group]
instance quotient.group : group (G ⧸ N) :=
(quotient_group.con N).group

/-- The group homomorphism from `G` to `G/N`. -/
@[to_additive quotient_add_group.mk' "The additive group homomorphism from `G` to `G/N`."]
def mk' : G →* G ⧸ N := monoid_hom.mk' (quotient_group.mk) (λ _ _, rfl)

@[simp, to_additive]
lemma coe_mk' : (mk' N : G → G ⧸ N) = coe := rfl

@[simp, to_additive]
lemma mk'_apply (x : G) : mk' N x = x := rfl

/-- Two `monoid_hom`s from a quotient group are equal if their compositions with
`quotient_group.mk'` are equal.

See note [partially-applied ext lemmas]. -/
@[ext, to_additive /-" Two `add_monoid_hom`s from an additive quotient group are equal if their
compositions with `add_quotient_group.mk'` are equal.

See note [partially-applied ext lemmas]. "-/]
lemma monoid_hom_ext ⦃f g : G ⧸ N →* H⦄ (h : f.comp (mk' N) = g.comp (mk' N)) : f = g :=
monoid_hom.ext $ λ x, quotient_group.induction_on x $ (monoid_hom.congr_fun h : _)

@[simp, to_additive quotient_add_group.eq_zero_iff]
lemma eq_one_iff {N : subgroup G} [nN : N.normal] (x : G) : (x : G ⧸ N) = 1 ↔ x ∈ N :=
begin
  refine quotient_group.eq.trans _,
  rw [mul_one, subgroup.inv_mem_iff],
end

@[simp, to_additive quotient_add_group.ker_mk]
lemma ker_mk :
  monoid_hom.ker (quotient_group.mk' N : G →* G ⧸ N) = N :=
subgroup.ext eq_one_iff

@[to_additive quotient_add_group.eq_iff_sub_mem]

-- for commutative groups we don't need normality assumption
omit nN

@[to_additive quotient_add_group.add_comm_group]
instance {G : Type*} [comm_group G] (N : subgroup G) : comm_group (G ⧸ N) :=
{ mul_comm := λ a b, quotient.induction_on₂' a b
    (λ a b, congr_arg mk (mul_comm a b)),
  .. @quotient_group.quotient.group _ _ N N.normal_of_comm }

include nN

local notation ` Q ` := G ⧸ N

@[simp, to_additive quotient_add_group.coe_zero]
lemma coe_one : ((1 : G) : Q) = 1 := rfl

@[simp, to_additive quotient_add_group.coe_add]
lemma coe_mul (a b : G) : ((a * b : G) : Q) = a * b := rfl

@[simp, to_additive quotient_add_group.coe_neg]
lemma coe_inv (a : G) : ((a⁻¹ : G) : Q) = a⁻¹ := rfl

@[simp, to_additive quotient_add_group.coe_sub]
lemma coe_div (a b : G) : ((a / b : G) : Q) = a / b := rfl

@[simp, to_additive quotient_add_group.coe_nsmul]
lemma coe_pow (a : G) (n : ℕ) : ((a ^ n : G) : Q) = a ^ n := rfl

@[simp, to_additive quotient_add_group.coe_zsmul]
lemma coe_zpow (a : G) (n : ℤ) : ((a ^ n : G) : Q) = a ^ n := rfl

/-- A group homomorphism `φ : G →* H` with `N ⊆ ker(φ)` descends (i.e. `lift`s) to a
group homomorphism `G/N →* H`. -/
@[to_additive quotient_add_group.lift "An `add_group` homomorphism `φ : G →+ H` with `N ⊆ ker(φ)`
descends (i.e. `lift`s) to a group homomorphism `G/N →* H`."]
def lift (φ : G →* H) (HN : ∀x∈N, φ x = 1) : Q →* H :=
(quotient_group.con N).lift φ $ λ x y (h : x⁻¹ * y ∈ N),
  calc φ x = φ (y * (x⁻¹ * y)⁻¹) : by rw [mul_inv_rev, inv_inv, mul_inv_cancel_left]
       ... = φ y                 : by rw [φ.map_mul, HN _ (N.inv_mem h), mul_one]

@[simp, to_additive quotient_add_group.lift_mk]
lemma lift_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
  lift N φ HN (g : Q) = φ g := rfl

@[simp, to_additive quotient_add_group.lift_mk']
lemma lift_mk' {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
  lift N φ HN (mk g : Q) = φ g := rfl

@[simp, to_additive quotient_add_group.lift_quot_mk]
lemma lift_quot_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
  lift N φ HN (quot.mk _ g : Q) = φ g := rfl

/-- A group homomorphism `f : G →* H` induces a map `G/N →* H/M` if `N ⊆ f⁻¹(M)`. -/
@[to_additive quotient_add_group.map "An `add_group` homomorphism `f : G →+ H` induces a map
`G/N →+ H/M` if `N ⊆ f⁻¹(M)`."]
def map (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) :
  G ⧸ N →* H ⧸ M :=
begin
  refine quotient_group.lift N ((mk' M).comp f) _,
  assume x hx,
  refine quotient_group.eq.2 _,
  rw [mul_one, subgroup.inv_mem_iff],
  exact h hx,
end

@[simp, to_additive quotient_add_group.map_coe] lemma map_coe
  (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
  map N M f h ↑x = ↑(f x) :=
lift_mk' _ _ x

@[to_additive quotient_add_group.map_mk'] lemma map_mk'
  (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
  map N M f h (mk' _ x) = ↑(f x) :=
quotient_group.lift_mk' _ _ x

omit nN
variables (φ : G →* H)

open function monoid_hom

/-- The induced map from the quotient by the kernel to the codomain. -/
@[to_additive quotient_add_group.ker_lift "The induced map from the quotient by the kernel to the
codomain."]
def ker_lift : G ⧸ ker φ →* H :=
lift _ φ $ λ g, φ.mem_ker.mp

@[simp, to_additive quotient_add_group.ker_lift_mk]
lemma ker_lift_mk (g : G) : (ker_lift φ) g = φ g :=
lift_mk _ _ _

@[simp, to_additive quotient_add_group.ker_lift_mk']
lemma ker_lift_mk' (g : G) : (ker_lift φ) (mk g) = φ g :=
lift_mk' _ _ _

@[to_additive quotient_add_group.ker_lift_injective]
lemma ker_lift_injective : injective (ker_lift φ) :=
assume a b, quotient.induction_on₂' a b $
  assume a b (h : φ a = φ b), quotient.sound' $
show a⁻¹ * b ∈ ker φ, by rw [mem_ker,
  φ.map_mul, ← h, φ.map_inv, inv_mul_self]

-- Note that `ker φ` isn't definitionally `ker (φ.range_restrict)`
-- so there is a bit of annoying code duplication here

/-- The induced map from the quotient by the kernel to the range. -/
@[to_additive quotient_add_group.range_ker_lift "The induced map from the quotient by the kernel to
the range."]
def range_ker_lift : G ⧸ ker φ →* φ.range :=
lift _ φ.range_restrict $ λ g hg, (mem_ker _).mp $ by rwa range_restrict_ker

@[to_additive quotient_add_group.range_ker_lift_injective]
lemma range_ker_lift_injective : injective (range_ker_lift φ) :=
assume a b, quotient.induction_on₂' a b $
  assume a b (h : φ.range_restrict a = φ.range_restrict b), quotient.sound' $
show a⁻¹ * b ∈ ker φ, by rw [←range_restrict_ker, mem_ker,
  φ.range_restrict.map_mul, ← h, φ.range_restrict.map_inv, inv_mul_self]

@[to_additive quotient_add_group.range_ker_lift_surjective]
lemma range_ker_lift_surjective : surjective (range_ker_lift φ) :=
begin
  rintro ⟨_, g, rfl⟩,
  use mk g,
  refl,
end

/-- **Noether's first isomorphism theorem** (a definition): the canonical isomorphism between
`G/(ker φ)` to `range φ`. -/
@[to_additive quotient_add_group.quotient_ker_equiv_range "The first isomorphism theorem
(a definition): the canonical isomorphism between `G/(ker φ)` to `range φ`."]
noncomputable def quotient_ker_equiv_range : G ⧸ ker φ ≃* range φ :=
mul_equiv.of_bijective (range_ker_lift φ) ⟨range_ker_lift_injective φ, range_ker_lift_surjective φ⟩

/-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a homomorphism `φ : G →* H`
with a right inverse `ψ : H → G`. -/
@[to_additive quotient_add_group.quotient_ker_equiv_of_right_inverse "The canonical isomorphism
`G/(ker φ) ≃+ H` induced by a homomorphism `φ : G →+ H` with a right inverse `ψ : H → G`.",
  simps]
def quotient_ker_equiv_of_right_inverse (ψ : H → G) (hφ : function.right_inverse ψ φ) :
  G ⧸ ker φ ≃* H :=
{ to_fun := ker_lift φ,
  inv_fun := mk ∘ ψ,
  left_inv := λ x, ker_lift_injective φ (by rw [function.comp_app, ker_lift_mk', hφ]),
  right_inv := hφ,
  .. ker_lift φ }

/-- The canonical isomorphism `G/⊥ ≃* G`. -/
@[to_additive quotient_add_group.quotient_bot "The canonical isomorphism `G/⊥ ≃+ G`.", simps]
def quotient_bot : G ⧸ (⊥ : subgroup G) ≃* G :=
quotient_ker_equiv_of_right_inverse (monoid_hom.id G) id (λ x, rfl)

/-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a surjection `φ : G →* H`.

For a `computable` version, see `quotient_group.quotient_ker_equiv_of_right_inverse`.
-/
@[to_additive quotient_add_group.quotient_ker_equiv_of_surjective "The canonical isomorphism
`G/(ker φ) ≃+ H` induced by a surjection `φ : G →+ H`.

For a `computable` version, see `quotient_add_group.quotient_ker_equiv_of_right_inverse`."]
noncomputable def quotient_ker_equiv_of_surjective (hφ : function.surjective φ) :
  G ⧸ (ker φ) ≃* H :=
quotient_ker_equiv_of_right_inverse φ _ hφ.has_right_inverse.some_spec

/-- If two normal subgroups `M` and `N` of `G` are the same, their quotient groups are
isomorphic. -/
@[to_additive "If two normal subgroups `M` and `N` of `G` are the same, their quotient groups are
isomorphic."]
def equiv_quotient_of_eq {M N : subgroup G} [M.normal] [N.normal] (h : M = N) :
  G ⧸ M ≃* G ⧸ N :=
{ to_fun := (lift M (mk' N) (λ m hm, quotient_group.eq.mpr (by simpa [← h] using M.inv_mem hm))),
  inv_fun := (lift N (mk' M) (λ n hn, quotient_group.eq.mpr (by simpa [← h] using N.inv_mem hn))),
  left_inv := λ x, x.induction_on' $ by { intro, refl },
  right_inv := λ x, x.induction_on' $ by { intro, refl },
  map_mul' := λ x y, by rw monoid_hom.map_mul }

@[simp, to_additive]
lemma equiv_quotient_of_eq_mk {M N : subgroup G} [M.normal] [N.normal] (h : M = N) (x : G) :
  quotient_group.equiv_quotient_of_eq h (quotient_group.mk x) = (quotient_group.mk x) :=
rfl

/-- Let `A', A, B', B` be subgroups of `G`. If `A' ≤ B'` and `A ≤ B`,
then there is a map `A / (A' ⊓ A) →* B / (B' ⊓ B)` induced by the inclusions. -/
@[to_additive "Let `A', A, B', B` be subgroups of `G`. If `A' ≤ B'` and `A ≤ B`,
then there is a map `A / (A' ⊓ A) →+ B / (B' ⊓ B)` induced by the inclusions."]
def quotient_map_subgroup_of_of_le {A' A B' B : subgroup G}
  [hAN : (A'.subgroup_of A).normal] [hBN : (B'.subgroup_of B).normal]
  (h' : A' ≤ B') (h : A ≤ B) :
  A ⧸ (A'.subgroup_of A) →* B ⧸ (B'.subgroup_of B) :=
map _ _ (subgroup.inclusion h) $
  by simp [subgroup.subgroup_of, subgroup.comap_comap]; exact subgroup.comap_mono h'

@[simp, to_additive]
lemma quotient_map_subgroup_of_of_le_coe {A' A B' B : subgroup G}
  [hAN : (A'.subgroup_of A).normal] [hBN : (B'.subgroup_of B).normal]
  (h' : A' ≤ B') (h : A ≤ B) (x : A) :
  quotient_map_subgroup_of_of_le h' h x = ↑(subgroup.inclusion h x : B) := rfl

/-- Let `A', A, B', B` be subgroups of `G`.
If `A' = B'` and `A = B`, then the quotients `A / (A' ⊓ A)` and `B / (B' ⊓ B)` are isomorphic.

Applying this equiv is nicer than rewriting along the equalities, since the type of
`(A'.subgroup_of A : subgroup A)` depends on on `A`.
-/
@[to_additive "Let `A', A, B', B` be subgroups of `G`.
If `A' = B'` and `A = B`, then the quotients `A / (A' ⊓ A)` and `B / (B' ⊓ B)` are isomorphic.

Applying this equiv is nicer than rewriting along the equalities, since the type of
`(A'.add_subgroup_of A : add_subgroup A)` depends on on `A`.
"]
def equiv_quotient_subgroup_of_of_eq {A' A B' B : subgroup G}
  [hAN : (A'.subgroup_of A).normal] [hBN : (B'.subgroup_of B).normal]
  (h' : A' = B') (h : A = B) :
  A ⧸ (A'.subgroup_of A) ≃* B ⧸ (B'.subgroup_of B) :=
monoid_hom.to_mul_equiv
  (quotient_map_subgroup_of_of_le h'.le h.le) (quotient_map_subgroup_of_of_le h'.ge h.ge)
  (by { ext ⟨x, hx⟩, refl })
  (by { ext ⟨x, hx⟩, refl })

section snd_isomorphism_thm

open _root_.subgroup

/-- **Noether's second isomorphism theorem**: given two subgroups `H` and `N` of a group `G`, where
`N` is normal, defines an isomorphism between `H/(H ∩ N)` and `(HN)/N`. -/
@[to_additive "The second isomorphism theorem: given two subgroups `H` and `N` of a group `G`,
where `N` is normal, defines an isomorphism between `H/(H ∩ N)` and `(H + N)/N`"]
noncomputable def quotient_inf_equiv_prod_normal_quotient (H N : subgroup G) [N.normal] :
  H ⧸ ((H ⊓ N).comap H.subtype) ≃* _ ⧸ (N.comap (H ⊔ N).subtype) :=
/- φ is the natural homomorphism H →* (HN)/N. -/
let φ : H →* _ ⧸ (N.comap (H ⊔ N).subtype) :=
  (mk' $ N.comap (H ⊔ N).subtype).comp (inclusion le_sup_left) in
have φ_surjective : function.surjective φ := λ x, x.induction_on' $
  begin
    rintro ⟨y, (hy : y ∈ ↑(H ⊔ N))⟩, rw mul_normal H N at hy,
    rcases hy with ⟨h, n, hh, hn, rfl⟩,
    use [h, hh], apply quotient.eq.mpr, change h⁻¹ * (h * n) ∈ N,
    rwa [←mul_assoc, inv_mul_self, one_mul],
  end,
(equiv_quotient_of_eq (by simp [comap_comap, ←comap_ker])).trans
  (quotient_ker_equiv_of_surjective φ φ_surjective)

end snd_isomorphism_thm

section third_iso_thm

variables (M : subgroup G) [nM : M.normal]

include nM nN

@[to_additive quotient_add_group.map_normal]
instance map_normal : (M.map (quotient_group.mk' N)).normal :=
{ conj_mem := begin
    rintro _ ⟨x, hx, rfl⟩ y,
    refine induction_on' y (λ y, ⟨y * x * y⁻¹, subgroup.normal.conj_mem nM x hx y, _⟩),
    simp only [mk'_apply, coe_mul, coe_inv]
  end }

variables (h : N ≤ M)

/-- The map from the third isomorphism theorem for groups: `(G / N) / (M / N) → G / M`. -/
@[to_additive quotient_add_group.quotient_quotient_equiv_quotient_aux
"The map from the third isomorphism theorem for additive groups: `(A / N) / (M / N) → A / M`."]
def quotient_quotient_equiv_quotient_aux :
  (G ⧸ N) ⧸ (M.map (mk' N)) →* G ⧸ M :=
lift (M.map (mk' N))
  (map N M (monoid_hom.id G) h)
  (by { rintro _ ⟨x, hx, rfl⟩, rw map_mk' N M _ _ x,
        exact (quotient_group.eq_one_iff _).mpr hx })

@[simp, to_additive quotient_add_group.quotient_quotient_equiv_quotient_aux_coe]
lemma quotient_quotient_equiv_quotient_aux_coe (x : G ⧸ N) :
  quotient_quotient_equiv_quotient_aux N M h x = quotient_group.map N M (monoid_hom.id G) h x :=
quotient_group.lift_mk' _ _ x

@[to_additive quotient_add_group.quotient_quotient_equiv_quotient_aux_coe_coe]
lemma quotient_quotient_equiv_quotient_aux_coe_coe (x : G) :
  quotient_quotient_equiv_quotient_aux N M h (x : G ⧸ N) =
    x :=
quotient_group.lift_mk' _ _ x

/-- **Noether's third isomorphism theorem** for groups: `(G / N) / (M / N) ≃ G / M`. -/
@[to_additive quotient_add_group.quotient_quotient_equiv_quotient
"**Noether's third isomorphism theorem** for additive groups: `(A / N) / (M / N) ≃ A / M`."]
def quotient_quotient_equiv_quotient :
  (G ⧸ N) ⧸ (M.map (quotient_group.mk' N)) ≃* G ⧸ M :=
monoid_hom.to_mul_equiv
  (quotient_quotient_equiv_quotient_aux N M h)
  (quotient_group.map _ _ (quotient_group.mk' N) (subgroup.le_comap_map _ _))
  (by { ext, simp })
  (by { ext, simp })

end third_iso_thm

section trivial

@[to_additive] lemma subsingleton_quotient_top :
  subsingleton (G ⧸ (⊤ : subgroup G)) :=
trunc.subsingleton

/-- If the quotient by a subgroup gives a singleton then the subgroup is the whole group. -/
@[to_additive] lemma subgroup_eq_top_of_subsingleton (H : subgroup G)
  (h : subsingleton (G ⧸ H)) : H = ⊤ :=
top_unique $ λ x _,
  have this : 1⁻¹ * x ∈ H := quotient_group.eq.1 (subsingleton.elim _ _),
  by rwa [one_inv, one_mul] at this

end trivial

@[to_additive quotient_add_grup.comap_comap_center]
lemma comap_comap_center {H₁ : subgroup G} [H₁.normal] {H₂ : subgroup (G ⧸ H₁)} [H₂.normal] :
  (((subgroup.center ((G ⧸ H₁) ⧸ H₂))).comap (mk' H₂)).comap (mk' H₁) =
  (subgroup.center (G ⧸ H₂.comap (mk' H₁))).comap (mk' (H₂.comap (mk' H₁))) :=
begin
  ext x,
  simp only [mk'_apply, subgroup.mem_comap, subgroup.mem_center_iff, forall_coe],
  apply forall_congr,
  change ∀ (y : G), (↑↑(y * x) = ↑↑(x * y) ↔ ↑(y * x) = ↑(x * y)),
  intro y,
  repeat { rw [eq_iff_div_mem] },
  simp,
end

end quotient_group


import regular_sequence

/-- `lim_zero f` holds when `f` approaches 0. -/
def lim_zero (f : regular_sequence) := (∀ (j: ℕ), 0 < j → ∃ N, ∀ n ≥ N, | f n | ≤ (j: ℚ)⁻¹)

theorem add_lim_zero {f g : regular_sequence}
  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f + g) :=
  begin
    intros j hj,
    obtain ⟨N₁, hN₁⟩ := hf (2*j) (mul_pos zero_lt_two hj),
    obtain ⟨N₂, hN₂⟩ := hg (2*j) (mul_pos zero_lt_two hj),
    use max N₁ N₂,
    intros n hn,
    have h3 : | f (2*n) | + | g (2*n) | ≤ (2*j: ℚ)⁻¹+ (2*j: ℚ)⁻¹,
    {
      have hfg : | f (2*n) | ≤ (2*j: ℚ)⁻¹ ∧ | g (2*n) | ≤ (2*j: ℚ)⁻¹,
      {
        have : 2*n ≥ N₁ ∧ 2*n ≥ N₂,
        {
          have : n ≤ 2 * n,
          {
            obtain h := mul_le_mul one_le_two rfl.ge (zero_le n) (zero_le 2),
            rwa one_mul at h,
          },
          exact ⟨le_trans (le_of_max_le_left hn) this, le_trans (le_of_max_le_right hn) this⟩
        },
        obtain tt := hN₁ (2*n) this.1,
        obtain ttt := hN₂ (2*n) this.2,
        simp only [nat.cast_bit0, nat.cast_one, nat.cast_mul] at *,
        exact ⟨tt,ttt⟩,
      },
      exact add_le_add hfg.1 hfg.2,
    },
    rw [← one_mul (j : ℚ)⁻¹ ,← mul_inv_cancel (@two_ne_zero ℚ _ _), mul_assoc, ← @mul_inv₀ ℚ _ 2 (j : ℚ), two_mul],
    exact le_trans (abs_add (f (2 * n)) (g (2 * n))) h3,
  end

lemma neg_lim_zero{a: regular_sequence}(ha: lim_zero a): lim_zero (-a) :=
  begin
    sorry,
  end

lemma sub_lim_zero{a b: regular_sequence}(ha: lim_zero a)(hb: lim_zero b): lim_zero (a - b) :=
  begin
    sorry,
  end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.specific_limits
import Mathlib.order.filter.countable_Inter
import Mathlib.topology.G_delta
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Baire theorem

In a complete metric space, a countable intersection of dense open subsets is dense.

The good concept underlying the theorem is that of a Gδ set, i.e., a countable intersection
of open sets. Then Baire theorem can also be formulated as the fact that a countable
intersection of dense Gδ sets is a dense Gδ set. We prove Baire theorem, giving several different
formulations that can be handy. We also prove the important consequence that, if the space is
covered by a countable union of closed sets, then the union of their interiors is dense.

The names of the theorems do not contain the string "Baire", but are instead built from the form of
the statement. "Baire" is however in the docstring of all the theorems, to facilitate grep searches.

We also define the filter `residual α` generated by dense `Gδ` sets and prove that this filter
has the countable intersection property.
-/

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here when
the source space is ℕ (and subsumed below by `dense_Inter_of_open` working with any
encodable source space). -/
theorem dense_Inter_of_open_nat {α : Type u_1} [emetric_space α] [complete_space α] {f : ℕ → set α} (ho : ∀ (n : ℕ), is_open (f n)) (hd : ∀ (n : ℕ), dense (f n)) : dense (set.Inter fun (n : ℕ) => f n) := sorry

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with ⋂₀. -/
theorem dense_sInter_of_open {α : Type u_1} [emetric_space α] [complete_space α] {S : set (set α)} (ho : ∀ (s : set α), s ∈ S → is_open s) (hS : set.countable S) (hd : ∀ (s : set α), s ∈ S → dense s) : dense (⋂₀S) := sorry

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_open {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] {S : set β} {f : β → set α} (ho : ∀ (s : β), s ∈ S → is_open (f s)) (hS : set.countable S) (hd : ∀ (s : β), s ∈ S → dense (f s)) : dense (set.Inter fun (s : β) => set.Inter fun (H : s ∈ S) => f s) := sorry

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_Inter_of_open {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] [encodable β] {f : β → set α} (ho : ∀ (s : β), is_open (f s)) (hd : ∀ (s : β), dense (f s)) : dense (set.Inter fun (s : β) => f s) := sorry

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with ⋂₀. -/
theorem dense_sInter_of_Gδ {α : Type u_1} [emetric_space α] [complete_space α] {S : set (set α)} (ho : ∀ (s : set α), s ∈ S → is_Gδ s) (hS : set.countable S) (hd : ∀ (s : set α), s ∈ S → dense s) : dense (⋂₀S) := sorry

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_Inter_of_Gδ {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] [encodable β] {f : β → set α} (ho : ∀ (s : β), is_Gδ (f s)) (hd : ∀ (s : β), dense (f s)) : dense (set.Inter fun (s : β) => f s) := sorry

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_Gδ {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] {S : set β} {f : (x : β) → x ∈ S → set α} (ho : ∀ (s : β) (H : s ∈ S), is_Gδ (f s H)) (hS : set.countable S) (hd : ∀ (s : β) (H : s ∈ S), dense (f s H)) : dense (set.Inter fun (s : β) => set.Inter fun (H : s ∈ S) => f s H) := sorry

/-- Baire theorem: the intersection of two dense Gδ sets is dense. -/
theorem dense.inter_of_Gδ {α : Type u_1} [emetric_space α] [complete_space α] {s : set α} {t : set α} (hs : is_Gδ s) (ht : is_Gδ t) (hsc : dense s) (htc : dense t) : dense (s ∩ t) := sorry

/-- A property holds on a residual (comeagre) set if and only if it holds on some dense `Gδ` set. -/
theorem eventually_residual {α : Type u_1} [emetric_space α] [complete_space α] {p : α → Prop} : filter.eventually (fun (x : α) => p x) (residual α) ↔ ∃ (t : set α), is_Gδ t ∧ dense t ∧ ∀ (x : α), x ∈ t → p x := sorry

/-- A set is residual (comeagre) if and only if it includes a dense `Gδ` set. -/
theorem mem_residual {α : Type u_1} [emetric_space α] [complete_space α] {s : set α} : s ∈ residual α ↔ ∃ (t : set α), ∃ (H : t ⊆ s), is_Gδ t ∧ dense t := sorry

protected instance residual.countable_Inter_filter {α : Type u_1} [emetric_space α] [complete_space α] : countable_Inter_filter (residual α) := sorry

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is a countable set in any type. -/
theorem dense_bUnion_interior_of_closed {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] {S : set β} {f : β → set α} (hc : ∀ (s : β), s ∈ S → is_closed (f s)) (hS : set.countable S) (hU : (set.Union fun (s : β) => set.Union fun (H : s ∈ S) => f s) = set.univ) : dense (set.Union fun (s : β) => set.Union fun (H : s ∈ S) => interior (f s)) := sorry

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with `⋃₀`. -/
theorem dense_sUnion_interior_of_closed {α : Type u_1} [emetric_space α] [complete_space α] {S : set (set α)} (hc : ∀ (s : set α), s ∈ S → is_closed s) (hS : set.countable S) (hU : ⋃₀S = set.univ) : dense (set.Union fun (s : set α) => set.Union fun (H : s ∈ S) => interior s) :=
  dense_bUnion_interior_of_closed hc hS (eq.mp (Eq._oldrec (Eq.refl (⋃₀S = set.univ)) set.sUnion_eq_bUnion) hU)

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is an encodable type. -/
theorem dense_Union_interior_of_closed {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] [encodable β] {f : β → set α} (hc : ∀ (s : β), is_closed (f s)) (hU : (set.Union fun (s : β) => f s) = set.univ) : dense (set.Union fun (s : β) => interior (f s)) := sorry

/-- One of the most useful consequences of Baire theorem: if a countable union of closed sets
covers the space, then one of the sets has nonempty interior. -/
theorem nonempty_interior_of_Union_of_closed {α : Type u_1} {β : Type u_2} [emetric_space α] [complete_space α] [Nonempty α] [encodable β] {f : β → set α} (hc : ∀ (s : β), is_closed (f s)) (hU : (set.Union fun (s : β) => f s) = set.univ) : ∃ (s : β), set.nonempty (interior (f s)) := sorry