/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro,
Scott Morrison

! This file was ported from Lean 3 source module data.list.lattice
! leanprover-community/mathlib commit dd71334db81d0bd444af1ee339a29298bef40734
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.List.Count
import Mathlib.Data.List.Infix
import Mathlib.Algebra.Order.Monoid.MinMax

/-!
# Lattice structure of lists

This files prove basic properties about `List.disjoint`, `List.union`, `List.inter` and
`List.bagInter`, which are defined in core Lean and `Data.List.Defs`.

`l₁ ∪ l₂` is the list where all elements of `l₁` have been inserted in `l₂` in order. For example,
`[0, 0, 1, 2, 2, 3] ∪ [4, 3, 3, 0] = [1, 2, 4, 3, 3, 0]`

`l₁ ∩ l₂` is the list of elements of `l₁` in order which are in `l₂`. For example,
`[0, 0, 1, 2, 2, 3] ∪ [4, 3, 3, 0] = [0, 0, 3]`

`List.bagInter l₁ l₂` is the list of elements that are in both `l₁` and `l₂`,
counted with multiplicity and in the order they appear in `l₁`.
As opposed to `List.inter`, `List.bagInter` copes well with multiplicity. For example,
`bagInter [0, 1, 2, 3, 2, 1, 0] [1, 0, 1, 4, 3] = [0, 1, 3, 1]`
-/

open Nat

namespace List

variable {α : Type _} {l l₁ l₂ : List α} {p : α → Prop} {a : α}

/-! ### `disjoint` -/

section Disjoint

theorem Disjoint.symm (d : Disjoint l₁ l₂) : Disjoint l₂ l₁ := fun _ i₂ i₁ => d i₁ i₂
#align list.disjoint.symm List.Disjoint.symm

#align list.disjoint_comm List.disjoint_comm
#align list.disjoint_left List.disjoint_left
#align list.disjoint_right List.disjoint_right
#align list.disjoint_iff_ne List.disjoint_iff_ne
#align list.disjoint_of_subset_left List.disjoint_of_subset_leftₓ
#align list.disjoint_of_subset_right List.disjoint_of_subset_right
#align list.disjoint_of_disjoint_cons_left List.disjoint_of_disjoint_cons_left
#align list.disjoint_of_disjoint_cons_right List.disjoint_of_disjoint_cons_right
#align list.disjoint_nil_left List.disjoint_nil_left
#align list.disjoint_nil_right List.disjoint_nil_right
#align list.singleton_disjoint List.singleton_disjointₓ
#align list.disjoint_singleton List.disjoint_singleton
#align list.disjoint_append_left List.disjoint_append_leftₓ
#align list.disjoint_append_right List.disjoint_append_right
#align list.disjoint_cons_left List.disjoint_cons_leftₓ
#align list.disjoint_cons_right List.disjoint_cons_right
#align list.disjoint_of_disjoint_append_left_left List.disjoint_of_disjoint_append_left_leftₓ
#align list.disjoint_of_disjoint_append_left_right List.disjoint_of_disjoint_append_left_rightₓ
#align list.disjoint_of_disjoint_append_right_left List.disjoint_of_disjoint_append_right_left
#align list.disjoint_of_disjoint_append_right_right List.disjoint_of_disjoint_append_right_right
#align list.disjoint_take_drop List.disjoint_take_dropₓ

end Disjoint

variable [DecidableEq α]

/-! ### `union` -/

section Union

#align list.nil_union List.nil_union
#align list.cons_union List.cons_unionₓ

@[simp]
theorem mem_union : a ∈ l₁ ∪ l₂ ↔ a ∈ l₁ ∨ a ∈ l₂ := by
  induction l₁
  · simp only [not_mem_nil, false_or_iff, instUnionList, nil_union]
  · simp only [find?, mem_cons, or_assoc, instUnionList, cons_union, mem_union_iff, mem_insert_iff]

#align list.mem_union List.mem_union

theorem mem_union_left (h : a ∈ l₁) (l₂ : List α) : a ∈ l₁ ∪ l₂ :=
  mem_union.2 (Or.inl h)
#align list.mem_union_left List.mem_union_left

theorem mem_union_right (l₁ : List α) (h : a ∈ l₂) : a ∈ l₁ ∪ l₂ :=
  mem_union.2 (Or.inr h)
#align list.mem_union_right List.mem_union_right

theorem sublist_suffix_of_union : ∀ l₁ l₂ : List α, ∃ t, t <+ l₁ ∧ t ++ l₂ = l₁ ∪ l₂
  | [], l₂ => ⟨[], by rfl, rfl⟩
  | a :: l₁, l₂ =>
    let ⟨t, s, e⟩ := sublist_suffix_of_union l₁ l₂
    if h : a ∈ l₁ ∪ l₂ then
      ⟨t, sublist_cons_of_sublist _ s, by
        simp only [instUnionList] at h
        simp only [e, instUnionList, cons_union, insert_of_mem h]⟩
    else
      ⟨a :: t, s.cons_cons _, by
        simp only [instUnionList] at h
        simp only [cons_append, instUnionList, cons_union, e, insert_of_not_mem h]⟩
#align list.sublist_suffix_of_union List.sublist_suffix_of_union

theorem suffix_union_right (l₁ l₂ : List α) : l₂ <:+ l₁ ∪ l₂ :=
  (sublist_suffix_of_union l₁ l₂).imp fun _ => And.right
#align list.suffix_union_right List.suffix_union_right

theorem union_sublist_append (l₁ l₂ : List α) : l₁ ∪ l₂ <+ l₁ ++ l₂ :=
  let ⟨_, s, e⟩ := sublist_suffix_of_union l₁ l₂
  e ▸ (append_sublist_append_right _).2 s
#align list.union_sublist_append List.union_sublist_append

theorem forall_mem_of_forall_mem_union_left (h : ∀ x ∈ l₁ ∪ l₂, p x) : ∀ x ∈ l₁, p x :=
  (forall_mem_union.1 h).1
#align list.forall_mem_of_forall_mem_union_left List.forall_mem_of_forall_mem_union_left

theorem forall_mem_of_forall_mem_union_right (h : ∀ x ∈ l₁ ∪ l₂, p x) : ∀ x ∈ l₂, p x :=
  (forall_mem_union.1 h).2
#align list.forall_mem_of_forall_mem_union_right List.forall_mem_of_forall_mem_union_right

end Union

/-! ### `inter` -/

section Inter

@[simp]
theorem inter_nil (l : List α) : [] ∩ l = [] :=
  rfl
#align list.inter_nil List.inter_nil

@[simp]
theorem inter_cons_of_mem (l₁ : List α) (h : a ∈ l₂) : (a :: l₁) ∩ l₂ = a :: l₁ ∩ l₂ := by
  simp only [instInterList, List.inter, filter_cons_of_pos, h]
#align list.inter_cons_of_mem List.inter_cons_of_mem

@[simp]
theorem inter_cons_of_not_mem (l₁ : List α) (h : a ∉ l₂) : (a :: l₁) ∩ l₂ = l₁ ∩ l₂ := by
  simp only [instInterList, List.inter, filter_cons_of_neg, h]
#align list.inter_cons_of_not_mem List.inter_cons_of_not_mem

theorem mem_of_mem_inter_left : a ∈ l₁ ∩ l₂ → a ∈ l₁ :=
  mem_of_mem_filter
#align list.mem_of_mem_inter_left List.mem_of_mem_inter_left

theorem mem_of_mem_inter_right (h : a ∈ l₁ ∩ l₂) : a ∈ l₂ := by simpa using of_mem_filter h
#align list.mem_of_mem_inter_right List.mem_of_mem_inter_right

theorem mem_inter_of_mem_of_mem (h₁ : a ∈ l₁) (h₂ : a ∈ l₂) : a ∈ l₁ ∩ l₂ :=
  mem_filter_of_mem h₁ $ by simpa using h₂
#align list.mem_inter_of_mem_of_mem List.mem_inter_of_mem_of_mem

@[simp]
theorem mem_inter : a ∈ l₁ ∩ l₂ ↔ a ∈ l₁ ∧ a ∈ l₂ := by erw [mem_filter]; simp
#align list.mem_inter List.mem_inter

theorem inter_subset_left (l₁ l₂ : List α) : l₁ ∩ l₂ ⊆ l₁ :=
  filter_subset _
#align list.inter_subset_left List.inter_subset_left

theorem inter_subset_right (l₁ l₂ : List α) : l₁ ∩ l₂ ⊆ l₂ := fun _ => mem_of_mem_inter_right
#align list.inter_subset_right List.inter_subset_right

theorem subset_inter {l l₁ l₂ : List α} (h₁ : l ⊆ l₁) (h₂ : l ⊆ l₂) : l ⊆ l₁ ∩ l₂ := fun _ h =>
  mem_inter.2 ⟨h₁ h, h₂ h⟩
#align list.subset_inter List.subset_inter

theorem inter_eq_nil_iff_disjoint : l₁ ∩ l₂ = [] ↔ Disjoint l₁ l₂ := by
  simp only [eq_nil_iff_forall_not_mem, mem_inter, not_and]
  rfl
#align list.inter_eq_nil_iff_disjoint List.inter_eq_nil_iff_disjoint

theorem forall_mem_inter_of_forall_left (h : ∀ x ∈ l₁, p x) (l₂ : List α) :
    ∀ x, x ∈ l₁ ∩ l₂ → p x :=
  BAll.imp_left (fun _ => mem_of_mem_inter_left) h
#align list.forall_mem_inter_of_forall_left List.forall_mem_inter_of_forall_left

theorem forall_mem_inter_of_forall_right (l₁ : List α) (h : ∀ x ∈ l₂, p x) :
    ∀ x, x ∈ l₁ ∩ l₂ → p x :=
  BAll.imp_left (fun _ => mem_of_mem_inter_right) h
#align list.forall_mem_inter_of_forall_right List.forall_mem_inter_of_forall_right

@[simp]
theorem inter_reverse {xs ys : List α} : xs.inter ys.reverse = xs.inter ys := by
  simp only [List.inter, mem_reverse]
#align list.inter_reverse List.inter_reverse

end Inter

/-! ### `bagInter` -/

section BagInter

@[simp]
theorem nil_bagInter (l : List α) : [].bagInter l = [] := by cases l <;> rfl
#align list.nil_bag_inter List.nil_bagInter

@[simp]
theorem bagInter_nil (l : List α) : l.bagInter [] = [] := by cases l <;> rfl
#align list.bag_inter_nil List.bagInter_nil

@[simp]
theorem cons_bagInter_of_pos (l₁ : List α) (h : a ∈ l₂) :
    (a :: l₁).bagInter l₂ = a :: l₁.bagInter (l₂.erase a) := by
  cases l₂
  · exact if_pos h
  · simp only [List.bagInter, if_pos (elem_eq_true_of_mem h)]
#align list.cons_bag_inter_of_pos List.cons_bagInter_of_pos

@[simp]
theorem cons_bagInter_of_neg (l₁ : List α) (h : a ∉ l₂) :
    (a :: l₁).bagInter l₂ = l₁.bagInter l₂ := by
  cases l₂; · simp only [bagInter_nil]
  simp only [erase_of_not_mem h, List.bagInter, if_neg (mt mem_of_elem_eq_true h)]
#align list.cons_bag_inter_of_neg List.cons_bagInter_of_neg

@[simp]
theorem mem_bagInter {a : α} : ∀ {l₁ l₂ : List α}, a ∈ l₁.bagInter l₂ ↔ a ∈ l₁ ∧ a ∈ l₂
  | [], l₂ => by simp only [nil_bagInter, not_mem_nil, false_and_iff]
  | b :: l₁, l₂ => by
    by_cases h : b ∈ l₂
    · rw [cons_bagInter_of_pos _ h, mem_cons, mem_cons, mem_bagInter]
      by_cases ba : a = b
      · simp only [ba, h, eq_self_iff_true, true_or_iff, true_and_iff]
      · simp only [mem_erase_of_ne ba, ba, false_or_iff]
    · rw [cons_bagInter_of_neg _ h, mem_bagInter, mem_cons, or_and_right]
      symm
      apply or_iff_right_of_imp
      rintro ⟨rfl, h'⟩
      exact h.elim h'
#align list.mem_bag_inter List.mem_bagInter

@[simp]
theorem count_bagInter {a : α} :
    ∀ {l₁ l₂ : List α}, count a (l₁.bagInter l₂) = min (count a l₁) (count a l₂)
  | [], l₂ => by simp
  | l₁, [] => by simp
  | b :: l₁, l₂ => by
    by_cases hb : b ∈ l₂
    · rw [cons_bagInter_of_pos _ hb, count_cons', count_cons', count_bagInter, count_erase, ←
        min_add_add_right]
      by_cases ab : a = b
      · rw [if_pos ab, @tsub_add_cancel_of_le]
        rwa [succ_le_iff, count_pos, ab]
      · rw [if_neg ab, tsub_zero, add_zero, add_zero]
    · rw [cons_bagInter_of_neg _ hb, count_bagInter]
      by_cases ab : a = b
      · rw [← ab] at hb
        rw [count_eq_zero.2 hb, min_zero, min_zero]
      · rw [count_cons_of_ne ab]
#align list.count_bag_inter List.count_bagInter

theorem bagInter_sublist_left : ∀ l₁ l₂ : List α, l₁.bagInter l₂ <+ l₁
  | [], l₂ => by simp
  | b :: l₁, l₂ =>
    by
    by_cases h : b ∈ l₂ <;> simp only [h, cons_bagInter_of_pos, cons_bagInter_of_neg, not_false_iff]
    · exact (bagInter_sublist_left _ _).cons_cons _
    · apply sublist_cons_of_sublist
      apply bagInter_sublist_left
#align list.bag_inter_sublist_left List.bagInter_sublist_left

theorem bagInter_nil_iff_inter_nil : ∀ l₁ l₂ : List α, l₁.bagInter l₂ = [] ↔ l₁ ∩ l₂ = []
  | [], l₂ => by simp
  | b :: l₁, l₂ => by
    by_cases h : b ∈ l₂ <;> simp [h]
    exact bagInter_nil_iff_inter_nil l₁ l₂
#align list.bag_inter_nil_iff_inter_nil List.bagInter_nil_iff_inter_nil

end BagInter

end List


/-
Copyright (c) 2022 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez

! This file was ported from Lean 3 source module data.sign
! leanprover-community/mathlib commit 2445c98ae4b87eabebdde552593519b9b6dc350c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Order
import Mathlib.Data.Fintype.BigOperators
import Mathlib.Data.Int.Lemmas
/-!
# Sign function

This file defines the sign function for types with zero and a decidable less-than relation, and
proves some basic theorems about it.
-/

-- Porting note: Cannot automatically derive Fintype, added manually
/-- The type of signs. -/
inductive SignType
  | zero
  | neg
  | pos
  deriving DecidableEq, Inhabited
#align sign_type SignType

-- Porting note: these lemmas are autogenerated by the inductive definition and are not
-- in simple form due to the below `x_eq_x` lemmas
attribute [nolint simpNF] SignType.zero.sizeOf_spec
attribute [nolint simpNF] SignType.neg.sizeOf_spec
attribute [nolint simpNF] SignType.pos.sizeOf_spec

namespace SignType

-- Porting note: Added Fintype SignType manually
instance : Fintype SignType :=
   Fintype.ofMultiset (zero :: neg :: pos :: List.nil) (fun x ↦ by cases x <;> simp only)

instance : Zero SignType :=
  ⟨zero⟩

instance : One SignType :=
  ⟨pos⟩

instance : Neg SignType :=
  ⟨fun s =>
    match s with
    | neg => pos
    | zero => zero
    | pos => neg⟩

@[simp]
theorem zero_eq_zero : zero = 0 :=
  rfl
#align sign_type.zero_eq_zero SignType.zero_eq_zero

@[simp]
theorem neg_eq_neg_one : neg = -1 :=
  rfl
#align sign_type.neg_eq_neg_one SignType.neg_eq_neg_one

@[simp]
theorem pos_eq_one : pos = 1 :=
  rfl
#align sign_type.pos_eq_one SignType.pos_eq_one

instance : Mul SignType :=
  ⟨fun x y =>
    match x with
    | neg => -y
    | zero => zero
    | pos => y⟩

/-- The less-than relation on signs. -/
inductive Le : SignType → SignType → Prop
  | of_neg (a) : Le neg a
  | zero : Le zero zero
  | of_pos (a) : Le a pos
#align sign_type.le SignType.Le

instance : LE SignType :=
  ⟨Le⟩

instance Le.decidableRel : DecidableRel Le := fun a b => by
  cases a <;> cases b <;> first | exact isTrue (by constructor)| exact isFalse (by rintro ⟨_⟩)

instance decidableEq : DecidableEq SignType := fun a b => by
  cases a <;> cases b <;> first | exact isTrue (by constructor)| exact isFalse (by rintro ⟨_⟩)

private lemma mul_comm : ∀ (a b : SignType), a * b = b * a := by rintro ⟨⟩ ⟨⟩ <;> rfl
private lemma mul_assoc : ∀ (a b c : SignType), (a * b) * c = a * (b * c) := by
  rintro ⟨⟩ ⟨⟩ ⟨⟩ <;> rfl

/- We can define a `Field` instance on `SignType`, but it's not mathematically sensible,
so we only define the `CommGroupWithZero`. -/
instance : CommGroupWithZero SignType where
  zero := 0
  one := 1
  mul := (· * ·)
  inv := id
  mul_zero a := by cases a <;> rfl
  zero_mul a := by cases a <;> rfl
  mul_one a := by cases a <;> rfl
  one_mul a := by cases a <;> rfl
  mul_inv_cancel a ha := by cases a <;> trivial
  mul_comm := mul_comm
  mul_assoc := mul_assoc
  exists_pair_ne := ⟨0, 1, by rintro ⟨_⟩⟩
  inv_zero := rfl

private lemma le_antisymm (a b : SignType) (_ : a ≤ b) (_: b ≤ a) : a = b := by
  cases a <;> cases b <;> trivial

private lemma le_trans (a b c : SignType) (_ : a ≤ b) (_: b ≤ c) : a ≤ c := by
  cases a <;> cases b <;> cases c <;> first | tauto | constructor

instance : LinearOrder SignType where
  le := (· ≤ ·)
  le_refl a := by cases a <;> constructor
  le_total a b := by cases a <;> cases b <;> first | left; constructor | right; constructor
  le_antisymm := le_antisymm
  le_trans := le_trans
  decidable_le := Le.decidableRel
  decidable_eq := SignType.decidableEq

instance : BoundedOrder SignType where
  top := 1
  le_top := Le.of_pos
  bot := -1
  bot_le := Le.of_neg

instance : HasDistribNeg SignType :=
  { neg_neg := fun x => by cases x <;> rfl
    neg_mul := fun x y => by cases x <;> cases y <;> rfl
    mul_neg := fun x y => by cases x <;> cases y <;> rfl }

/-- `SignType` is equivalent to `Fin 3`. -/
def fin3Equiv : SignType ≃* Fin 3
    where
  toFun a :=
    match a with
    | 0 => ⟨0, by simp⟩
    | 1 => ⟨1, by simp⟩
    | -1 => ⟨2, by simp⟩
  invFun a :=
    match a with
    | ⟨0, _⟩ => 0
    | ⟨1, _⟩ => 1
    | ⟨2, _⟩ => -1
    | ⟨n + 3, h⟩ => (h.not_le le_add_self).elim
  left_inv a := by cases a <;> rfl
  right_inv a :=
    match a with
    | ⟨0, _⟩ => by simp
    | ⟨1, _⟩ => by simp
    | ⟨2, _⟩ => by simp
    | ⟨n + 3, h⟩ => by simp at h
  map_mul' a b := by
    cases a <;> cases b <;> simp
#align sign_type.fin3_equiv SignType.fin3Equiv

section CaseBashing

-- Porting note: a lot of these thms used to use decide! which is not implemented yet
theorem nonneg_iff {a : SignType} : 0 ≤ a ↔ a = 0 ∨ a = 1 := by cases a <;> decide
#align sign_type.nonneg_iff SignType.nonneg_iff

theorem nonneg_iff_ne_neg_one {a : SignType} : 0 ≤ a ↔ a ≠ -1 := by cases a <;> decide
#align sign_type.nonneg_iff_ne_neg_one SignType.nonneg_iff_ne_neg_one

theorem neg_one_lt_iff {a : SignType} : -1 < a ↔ 0 ≤ a := by cases a <;> decide
#align sign_type.neg_one_lt_iff SignType.neg_one_lt_iff

theorem nonpos_iff {a : SignType} : a ≤ 0 ↔ a = -1 ∨ a = 0 := by cases a <;> decide
#align sign_type.nonpos_iff SignType.nonpos_iff

theorem nonpos_iff_ne_one {a : SignType} : a ≤ 0 ↔ a ≠ 1 := by cases a <;> decide
#align sign_type.nonpos_iff_ne_one SignType.nonpos_iff_ne_one

theorem lt_one_iff {a : SignType} : a < 1 ↔ a ≤ 0 := by cases a <;> decide
#align sign_type.lt_one_iff SignType.lt_one_iff

@[simp]
theorem neg_iff {a : SignType} : a < 0 ↔ a = -1 := by cases a <;> decide
#align sign_type.neg_iff SignType.neg_iff

@[simp]
theorem le_neg_one_iff {a : SignType} : a ≤ -1 ↔ a = -1 :=
  le_bot_iff
#align sign_type.le_neg_one_iff SignType.le_neg_one_iff

@[simp]
theorem pos_iff {a : SignType} : 0 < a ↔ a = 1 := by cases a <;> decide
#align sign_type.pos_iff SignType.pos_iff

@[simp]
theorem one_le_iff {a : SignType} : 1 ≤ a ↔ a = 1 :=
  top_le_iff
#align sign_type.one_le_iff SignType.one_le_iff

@[simp]
theorem neg_one_le (a : SignType) : -1 ≤ a :=
  bot_le
#align sign_type.neg_one_le SignType.neg_one_le

@[simp]
theorem le_one (a : SignType) : a ≤ 1 :=
  le_top
#align sign_type.le_one SignType.le_one

@[simp]
theorem not_lt_neg_one (a : SignType) : ¬a < -1 :=
  not_lt_bot
#align sign_type.not_lt_neg_one SignType.not_lt_neg_one

@[simp]
theorem not_one_lt (a : SignType) : ¬1 < a :=
  not_top_lt
#align sign_type.not_one_lt SignType.not_one_lt

@[simp]
theorem self_eq_neg_iff (a : SignType) : a = -a ↔ a = 0 := by cases a <;> decide
#align sign_type.self_eq_neg_iff SignType.self_eq_neg_iff

@[simp]
theorem neg_eq_self_iff (a : SignType) : -a = a ↔ a = 0 := by cases a <;> decide
#align sign_type.neg_eq_self_iff SignType.neg_eq_self_iff

@[simp]
theorem neg_one_lt_one : (-1 : SignType) < 1 :=
  bot_lt_top
#align sign_type.neg_one_lt_one SignType.neg_one_lt_one

end CaseBashing

section cast

variable {α : Type _} [Zero α] [One α] [Neg α]

/-- Turn a `SignType` into zero, one, or minus one. This is a coercion instance, but note it is
only a `has_coe_t` instance: see note [use has_coe_t]. -/
@[coe]
def cast : SignType → α
  | zero => 0
  | pos => 1
  | neg => -1
#align sign_type.cast SignType.cast

-- Porting note: Translated has_coe_t to CoeTC
instance : CoeTC SignType α :=
  ⟨cast⟩

-- Porting note: `cast_eq_coe` removed, syntactic equality

@[simp]
theorem coe_zero : ↑(0 : SignType) = (0 : α) :=
  rfl
#align sign_type.coe_zero SignType.coe_zero

@[simp]
theorem coe_one : ↑(1 : SignType) = (1 : α) :=
  rfl
#align sign_type.coe_one SignType.coe_one

@[simp]
theorem coe_neg_one : ↑(-1 : SignType) = (-1 : α) :=
  rfl
#align sign_type.coe_neg_one SignType.coe_neg_one

end cast

/-- `SignType.cast` as a `MulWithZeroHom`. -/
@[simps]
def castHom {α} [MulZeroOneClass α] [HasDistribNeg α] : SignType →*₀ α
    where
  toFun := cast
  map_zero' := rfl
  map_one' := rfl
  map_mul' x y := by  cases x <;> cases y <;> simp [zero_eq_zero, pos_eq_one, neg_eq_neg_one]
#align sign_type.cast_hom SignType.castHom

--Porting note: new theorem
theorem univ_eq : (Finset.univ : Finset SignType) = {0, -1, 1} :=
  by decide

theorem range_eq {α} (f : SignType → α) : Set.range f = {f zero, f neg, f pos} := by
  classical rw [← Fintype.coe_image_univ, univ_eq]
  classical simp [Finset.coe_insert]
#align sign_type.range_eq SignType.range_eq

end SignType

variable {α : Type _}

open SignType

section Preorder

variable [Zero α] [Preorder α] [DecidableRel ((· < ·) : α → α → Prop)] {a : α}

-- Porting note: needed to rename this from sign to SignType.sign to avoid ambiguity with Int.sign
/-- The sign of an element is 1 if it's positive, -1 if negative, 0 otherwise. -/
def SignType.sign : α →o SignType :=
  ⟨fun a => if 0 < a then 1 else if a < 0 then -1 else 0, fun a b h =>
    by
    dsimp
    split_ifs with h₁ h₂ h₃ h₄ _ _ h₂ h₃ <;> try constructor
    · cases lt_irrefl 0 (h₁.trans <| h.trans_lt h₃)
    · cases h₂ (h₁.trans_le h)
    · cases h₄ (h.trans_lt h₃)⟩
#align sign SignType.sign

theorem sign_apply : sign a = ite (0 < a) 1 (ite (a < 0) (-1) 0) :=
  rfl
#align sign_apply sign_apply

@[simp]
theorem sign_zero : sign (0 : α) = 0 := by simp [sign_apply]
#align sign_zero sign_zero

@[simp]
theorem sign_pos (ha : 0 < a) : sign a = 1 := by rwa [sign_apply, if_pos]
#align sign_pos sign_pos

@[simp]

theorem sign_eq_one_iff : sign a = 1 ↔ 0 < a := by
  refine' ⟨fun h => _, fun h => sign_pos h⟩
  by_contra hn
  rw [sign_apply, if_neg hn] at h
  split_ifs at h
#align sign_eq_one_iff sign_eq_one_iff

theorem sign_eq_neg_one_iff : sign a = -1 ↔ a < 0 := by
  refine' ⟨fun h => _, fun h => sign_neg h⟩
  rw [sign_apply] at h
  split_ifs at h
  · assumption
#align sign_eq_neg_one_iff sign_eq_neg_one_iff

end Preorder

section LinearOrder

variable [Zero α] [LinearOrder α] {a : α}

@[simp]
theorem sign_eq_zero_iff : sign a = 0 ↔ a = 0 := by
  refine' ⟨fun h => _, fun h => h.symm ▸ sign_zero⟩
  rw [sign_apply] at h
  split_ifs at h with h_1 h_2
  cases' h
  exact (le_of_not_lt h_1).eq_of_not_lt h_2
#align sign_eq_zero_iff sign_eq_zero_iff

theorem sign_ne_zero : sign a ≠ 0 ↔ a ≠ 0 :=
  sign_eq_zero_iff.not
#align sign_ne_zero sign_ne_zero

@[simp]
theorem sign_nonneg_iff : 0 ≤ sign a ↔ 0 ≤ a := by
  rcases lt_trichotomy 0 a with (h | h | h)
  · simp [h, h.le]
  · simp [←h]
  · simp [h, h.not_le]
#align sign_nonneg_iff sign_nonneg_iff

@[simp]
theorem sign_nonpos_iff : sign a ≤ 0 ↔ a ≤ 0 := by
  rcases lt_trichotomy 0 a with (h | h | h)
  · simp [h, h.not_le]
  · simp [←h]
  · simp [h, h.le]
#align sign_nonpos_iff sign_nonpos_iff

end LinearOrder

section OrderedSemiring

variable [OrderedSemiring α] [DecidableRel ((· < ·) : α → α → Prop)] [Nontrivial α]

-- @[simp] -- Porting note: simp can prove this
theorem sign_one : sign (1 : α) = 1 :=
  sign_pos zero_lt_one
#align sign_one sign_one

end OrderedSemiring

section LinearOrderedRing

variable [LinearOrderedRing α] {a b : α}

/- I'm not sure why this is necessary, see https://leanprover.zulipchat.com/#narrow/stream/
113488-general/topic/type.20class.20inference.20issues/near/276937942 -/
attribute [local instance] LinearOrderedRing.decidable_lt

theorem sign_mul (x y : α) : sign (x * y) = sign x * sign y := by
  rcases lt_trichotomy x 0 with (hx | hx | hx) <;> rcases lt_trichotomy y 0 with (hy | hy | hy) <;>
    simp [hx, hy, mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, mul_neg_of_pos_of_neg]
#align sign_mul sign_mul

@[simp] theorem sign_mul_abs (x : α) : (sign x * |x| : α) = x := by
  rcases lt_trichotomy x 0 with (hx | rfl | hx)
  · rw [sign_neg hx, abs_of_neg hx, coe_neg_one, neg_one_mul, neg_neg]
  · rw [abs_zero, mul_zero]
  · rw [sign_pos hx, abs_of_pos hx, coe_one, one_mul]

@[simp] theorem abs_mul_sign (x : α) : (|x| * sign x : α) = x := by
  rcases lt_trichotomy x 0 with (hx | rfl | hx)
  · rw [sign_neg hx, abs_of_neg hx, coe_neg_one, mul_neg_one, neg_neg]
  · rw [abs_zero, zero_mul]
  · rw [sign_pos hx, abs_of_pos hx, coe_one, mul_one]

/-- `sign` as a `MonoidWithZeroHom` for a nontrivial ordered semiring. Note that linearity
is required; consider ℂ with the order `z ≤ w` iff they have the same imaginary part and
`z - w ≤ 0` in the reals; then `1 + i` and `1 - i` are incomparable to zero, and thus we have:
`0 * 0 = sign (1 + i) * sign (1 - i) ≠ sign 2 = 1`. (`Complex.orderedCommRing`) -/
def signHom : α →*₀ SignType where
  toFun := sign
  map_zero' := sign_zero
  map_one' := sign_one
  map_mul' := sign_mul
#align sign_hom signHom

theorem sign_pow (x : α) (n : ℕ) : sign (x ^ n) = sign x ^ n := map_pow signHom x n
#align sign_pow sign_pow

end LinearOrderedRing

section AddGroup

variable [AddGroup α] [Preorder α] [DecidableRel ((· < ·) : α → α → Prop)]

theorem Left.sign_neg [CovariantClass α α (· + ·) (· < ·)] (a : α) : sign (-a) = -sign a := by
  simp_rw [sign_apply, Left.neg_pos_iff, Left.neg_neg_iff]
  split_ifs with h h'
  · exact False.elim (lt_asymm h h')
  · simp
  · simp
  · simp
#align left.sign_neg Left.sign_neg

theorem Right.sign_neg [CovariantClass α α (Function.swap (· + ·)) (· < ·)] (a : α) :
    sign (-a) = -sign a := by
  simp_rw [sign_apply, Right.neg_pos_iff, Right.neg_neg_iff]
  split_ifs with h h'
  · exact False.elim (lt_asymm h h')
  · simp
  · simp
  · simp
#align right.sign_neg Right.sign_neg

end AddGroup

section LinearOrderedAddCommGroup
open BigOperators

variable [LinearOrderedAddCommGroup α]

/- I'm not sure why this is necessary, see
https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Decidable.20vs.20decidable_rel
-/
attribute [local instance] LinearOrderedAddCommGroup.decidable_lt

theorem sign_sum {ι : Type _} {s : Finset ι} {f : ι → α} (hs : s.Nonempty) (t : SignType)
    (h : ∀ i ∈ s, sign (f i) = t) : sign (∑ i in s, f i) = t := by
  cases t
  · simp_rw [zero_eq_zero, sign_eq_zero_iff] at h⊢
    exact Finset.sum_eq_zero h
  · simp_rw [neg_eq_neg_one, sign_eq_neg_one_iff] at h⊢
    exact Finset.sum_neg h hs
  · simp_rw [pos_eq_one, sign_eq_one_iff] at h⊢
    exact Finset.sum_pos h hs
#align sign_sum sign_sum

end LinearOrderedAddCommGroup

namespace Int

theorem sign_eq_sign (n : ℤ) : Int.sign n = SignType.sign n := by
  obtain (n | _) | _ := n <;> simp [sign, Int.sign_neg, negSucc_lt_zero]
#align int.sign_eq_sign Int.sign_eq_sign

end Int

open Finset Nat

open BigOperators

/- Porting note: For all the following theorems, needed to add {α : Type u_1} to the assumptions
because lean4 infers α to live in a different universe u_2 otherwise -/
private theorem exists_signed_sum_aux {α : Type u_1} [DecidableEq α] (s : Finset α) (f : α → ℤ) :
    ∃ (β : Type u_1) (t : Finset β) (sgn : β → SignType) (g : β → α),
      (∀ b, g b ∈ s) ∧
        (t.card = ∑ a in s, (f a).natAbs) ∧
          ∀ a ∈ s, (∑ b in t, if g b = a then (sgn b : ℤ) else 0) = f a := by
  refine'
    ⟨(Σ _ : { x // x ∈ s }, ℕ), Finset.univ.sigma fun a => range (f a).natAbs,
      fun a => sign (f a.1), fun a => a.1, fun a => a.1.2, _, _⟩
  · simp [sum_attach (f := fun a => (f a).natAbs)]
  · intro x hx
    simp [sum_sigma, hx, ← Int.sign_eq_sign, Int.sign_mul_abs, mul_comm (|f _|),
      sum_attach (s := s) (f := fun y => if y = x then f y else 0)]

/-- We can decompose a sum of absolute value `n` into a sum of `n` signs. -/
theorem exists_signed_sum {α : Type u_1} [DecidableEq α] (s : Finset α) (f : α → ℤ) :
    ∃ (β : Type u_1) (_ : Fintype β) (sgn : β → SignType) (g : β → α),
      (∀ b, g b ∈ s) ∧
        (Fintype.card β = ∑ a in s, (f a).natAbs) ∧
          ∀ a ∈ s, (∑ b, if g b = a then (sgn b : ℤ) else 0) = f a :=
  let ⟨β, t, sgn, g, hg, ht, hf⟩ := exists_signed_sum_aux s f
  ⟨t, inferInstance, fun b => sgn b, fun b => g b, fun b => hg b, by simp [ht], fun a ha =>
    (@sum_attach _ _ t _ fun b => ite (g b = a) (sgn b : ℤ) 0).trans <| hf _ ha⟩
#align exists_signed_sum exists_signed_sum

/-- We can decompose a sum of absolute value less than `n` into a sum of at most `n` signs. -/
theorem exists_signed_sum' {α : Type u_1} [Nonempty α] [DecidableEq α] (s : Finset α) (f : α → ℤ)
  (n : ℕ) (h : (∑ i in s, (f i).natAbs) ≤ n) :
    ∃ (β : Type u_1) (_ : Fintype β) (sgn : β → SignType) (g : β → α),
      (∀ b, g b ∉ s → sgn b = 0) ∧
        Fintype.card β = n ∧ ∀ a ∈ s, (∑ i, if g i = a then (sgn i : ℤ) else 0) = f a := by
  obtain ⟨β, _, sgn, g, hg, hβ, hf⟩ := exists_signed_sum s f
  refine'
    ⟨Sum β (Fin (n - ∑ i in s, (f i).natAbs)), inferInstance, Sum.elim sgn 0,
      Sum.elim g (Classical.arbitrary (Fin (n - Finset.sum s fun i => Int.natAbs (f i)) → α)),
        _, by simp [hβ, h], fun a ha => by simp [hf _ ha]⟩
  rintro (b | b) hb
  · cases hb (hg _)
  · rfl
#align exists_signed_sum' exists_signed_sum'


import .gram_sqrt
import .polar_decomp

open_locale big_operators complex_conjugate matrix

variables {n : ℕ} (T : Lℂ^n)

local notation `R` := (sqrt' T)

noncomputable def singular_values : (fin n → ℝ) := (R_sa T).eigenvalues hn

noncomputable def e_basis : (basis (fin n) ℂ (ℂ^n)) := (gram_sa T).eigenvector_basis hn

noncomputable def S := classical.some (lem_7_45 T)

lemma lin_iso_preserves_onb' (b : basis (fin n) ℂ ℂ^n) (h : orthonormal ℂ b) : orthonormal ℂ ((S T) ∘ b) :=
begin
  unfold orthonormal,
  split,
  intro i,
  apply norm_sq_one_norm_eq_one,
  apply complex.of_real_injective,

  calc ↑(∥(⇑(S T) ∘ ⇑b) i∥ ^ 2) = (∥ ((S T) ∘ b) i ∥ : ℂ )^2 : by {simp only [complex.of_real_pow, linear_isometry_equiv.coe_to_linear_isometry, eq_self_iff_true, function.comp_app, linear_isometry_equiv.norm_map]}
    ...              = ↑∥ (S T) (b i) ∥^2 : by {simp only [linear_isometry_equiv.coe_to_linear_isometry, eq_self_iff_true, function.comp_app, linear_isometry_equiv.norm_map]}
    ...              = ⟪ (S T) (b i), (S T) (b i) ⟫_ℂ : by {rw inner_self_eq_norm_sq_to_K}
    ...              = ⟪ b i , b i ⟫_ℂ : by {rw linear_isometry.inner_map_map}
    ...              = (∥ b i ∥^2 : ℂ) : by {rw inner_self_eq_norm_sq_to_K}
    ...              = ((1 : ℝ) : ℂ) : by {rw h.1 i, simp only [one_pow, complex.of_real_one, eq_self_iff_true]},
  intros i j hij,
  rw linear_isometry.inner_map_map,
  exact h.2 hij,
end

lemma R_v_sum (v : ℂ^n) (R_is_sa : is_sa R) (h_fin : finite_dimensional.finrank ℂ (ℂ^n) = n): R v = ∑ (i : (fin n)), ⟪ (R_is_sa.eigenvector_basis h_fin i), v ⟫_ℂ • R (R_is_sa.eigenvector_basis h_fin i) :=
  begin
  let b := inner_product_space.is_self_adjoint.eigenvector_basis R_is_sa h_fin,
  have hb := inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal R_is_sa h_fin,
  conv
  begin
    to_lhs,
    rw onb_sum_repr b v hb,
    skip,
  end,
  calc R (∑ (i : fin n), ⟪ b i, v ⟫_ℂ • (b i)) = ∑ (i : fin n), R (⟪ b i, v ⟫_ℂ • (b i)) : by {rw linear_map.map_sum}
    ...                                        = ∑ (i : fin n), ⟪ b i, v ⟫_ℂ • R (b i) : by {simp only [is_R_or_C.inner_apply,
        inner_product_space.is_self_adjoint.apply_eigenvector_basis,
        pi_Lp.inner_apply,
        eq_self_iff_true,
        complex.coe_smul,
        linear_map.map_smul,
        finset.sum_congr]}
    ...           = ∑ (i : (fin n)), ⟪ (R_is_sa.eigenvector_basis h_fin i), v ⟫_ℂ • R (R_is_sa.eigenvector_basis h_fin i) : by {simp only [b]},
end

lemma h_fin : finite_dimensional.finrank ℂ (ℂ^n) = n :=
begin
  simp only [fintype.card_fin, finrank_euclidean_space, eq_self_iff_true],
end

lemma lin_ind (L : (ℂ^n) →ₗᵢ[ℂ] ℂ^n) (b : basis (fin n) ℂ ℂ^n) : linear_independent ℂ (L ∘ b) :=
begin
  apply linear_independent.map',
  exact b.linear_independent,

  rw linear_map.ker_eq_bot,
  exact L.injective,
end

lemma span (L : (ℂ^n) →ₗᵢ[ℂ] ℂ^n) (b : basis (fin n) ℂ ℂ^n) : submodule.span ℂ (set.range (L.to_linear_map ∘ b)) = ⊤ :=
begin
  let b' := (L ∘ b),
  have hlin := lin_ind L b,
  let b'' := basis.span hlin,
  rw set.range_comp,

  rw submodule.span_image (L.to_linear_map),
  rw b.span_eq,

  rw submodule.map_top,

  rw linear_map.range_eq_top,
  rw ← linear_map.injective_iff_surjective,
  have := linear_isometry.injective L,
  simp only [linear_isometry.coe_to_linear_map, this],
end

#check orthonormal_basis
noncomputable def svd_left (T : Lℂ^n) : orthonormal_basis (fin n) ℂ (ℂ^n) :=
begin
  have R_is_sa := R_sa T,
  exact (inner_product_space.is_self_adjoint.eigenvector_basis R_is_sa h_fin).to_orthonormal_basis (inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal R_is_sa h_fin),
end

noncomputable def svd_right (T : Lℂ^n) : orthonormal_basis (fin n) ℂ (ℂ^n) :=
begin
  have R_is_sa := R_sa T,
  let b' : basis (fin n) ℂ ℂ^n := inner_product_space.is_self_adjoint.eigenvector_basis R_is_sa h_fin,
  have hb' : orthonormal ℂ b' := inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal R_is_sa h_fin,
  let f' := (S T) ∘ b',
  have hsp : submodule.span ℂ (set.range f') = ⊤ := span (S T) b',
  have hon : orthonormal ℂ f' :=
  begin
    split,
    intro i,
    simp only [f'],
    rw function.comp_apply,
    rw (S T).norm_map,
    exact hb'.1 i,
    intros i j hij,
    simp only [f'],
    iterate {rw function.comp_apply},
    rw (S T).inner_map_map,
    exact hb'.2 hij,
  end,
  exact orthonormal_basis.mk hon hsp,
end

lemma S_left_eq_right (T : Lℂ^n) : (S T) ∘ (svd_left T) = svd_right T :=
begin
  simp only [svd_left, svd_right],
  simp only [orthonormal_basis.coe_mk, basis.coe_to_orthonormal_basis, eq_self_iff_true],
end

lemma sqrt_left_eig (T : Lℂ^n) (i : fin n) : (sqrt' T) (svd_left T i) = (singular_values T i) • (svd_left T i) :=
begin
  rw svd_left,
  simp only [inner_product_space.is_self_adjoint.apply_eigenvector_basis,
 basis.coe_to_orthonormal_basis,
 complex.coe_smul],
 congr,
end

lemma sqrt_eq_sum_inner_sing_left (v : ℂ^n) :
  (sqrt' T) v = ∑ (i : fin n), ⟪((svd_left T) i), v ⟫_ℂ • singular_values T i • (svd_left T) i :=
begin
  have := orthonormal_basis.sum_repr_symm (fin n) ℂ (ℂ^n) (svd_left T) ((svd_left T).repr v),
  rw linear_isometry_equiv.symm_apply_apply at this,
  conv_lhs {rw ← this},
  rw linear_map.map_sum,
  simp_rw linear_map.map_smul,
  simp_rw orthonormal_basis.repr_apply_apply,
  simp_rw sqrt_left_eig T _,
end

lemma iso_sqrt_eq_sum (v : ℂ^n) : (S T) (R v) = ∑ (i : fin n), ⟪ (svd_left T i), v ⟫_ℂ • (singular_values T i) • (S T) (svd_left T i) :=
begin
  calc (S T) (R v) = (S T) (∑ (i : fin n), ⟪ (svd_left T i), v ⟫_ℂ • (singular_values T i) • (svd_left T i)) : by {rw sqrt_eq_sum_inner_sing_left}
    ...           = (S T).to_linear_map (∑ (i : fin n), ⟪ (svd_left T i), v ⟫_ℂ • (singular_values T i) • (svd_left T i)) : by {congr}
    ...           = ∑ (i : fin n), ⟪ (svd_left T i), v ⟫_ℂ •  (singular_values T i) • (S T) (svd_left T i) : by {simp_rw [(S T).to_linear_map.map_sum, (S T).to_linear_map.map_smul, linear_map.map_smul_of_tower, linear_isometry.coe_to_linear_map]},
end

theorem svd_2 (T : Lℂ^n) : ∀ v : ℂ^n,
  T v = ∑ (i : (fin n)), ⟪ (svd_left T) i, v ⟫_ℂ • singular_values T i • ((svd_right T) i) :=
begin
  have R_is_sa := R_sa T,
  intro v,
  rw ← S_left_eq_right,
  show T v = ∑ (i : fin n), ⟪ (svd_left T i), v ⟫_ℂ • (singular_values T i) • (S T) (svd_left T i),
  rw ← iso_sqrt_eq_sum,
  exact classical.some_spec (lem_7_45 T) v,
end

-- theorem svd (T : Lℂ^n) : ∃ e f : basis (fin n) ℂ (ℂ^n),
--     (orthonormal ℂ e ∧ orthonormal ℂ f) ∧ ∀ v : ℂ^n, T v = ∑ (i : (fin n)), singular_values T i • ⟪e i, v ⟫_ℂ • (f i) :=
--   begin
--     have R_is_sa := R_sa T,
--     let b := inner_product_space.is_self_adjoint.eigenvector_basis R_is_sa h_fin,
--     have hb := inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal R_is_sa h_fin,

--     have hₛ : ∀ v : ℂ^n, (T v = (S T) (R v)) := classical.some_spec (lem_7_45 T),

--     let f' := (S T) ∘ b,
--     have hli : linear_independent ℂ f' := lin_ind ((S T)) b,
--     have hsp : submodule.span ℂ (set.range f') = ⊤ := span ((S T)) b,
--     let f := basis.mk hli hsp,

--     use b,
--     use f,

--     split,
--     split,
--     exact hb,

--     have : orthonormal ℂ (S T ∘ b) := lin_iso_preserves_onb' T b hb,
--     have f_def : (S T) ∘ b = f :=
--     begin
--       simp only [f],
--       rw basis.coe_mk,
--     end,
--     rw ← f_def,
--     exact this,

--     intro v,

--     have : R v = ∑ (i : (fin n)), ⟪ (b i), v ⟫_ℂ • (R (b i)) := R_v_sum T v R_is_sa _,

--     have eq₂ : (S T) (R v) = ∑ (i : fin n), ⟪ (b i), v ⟫_ℂ • (S T) (R (b i)) :=
--       begin
--           calc (S T) (R v) = (S T) (∑ (i : fin n), ⟪ (b i), v ⟫_ℂ • R (b i)) : by {rw this}
--             ...        = (S T).to_linear_map (∑ (i : fin n), ⟪ (b i), v ⟫_ℂ • R (b i)) : by {norm_cast}
--             ...        = ∑ (i : fin n), (S T) (⟪ (b i), v ⟫_ℂ • R (b i)) : by {rw linear_map.map_sum, norm_cast}
--             ...        = (∑ (i : fin n), ⟪ (b i), v ⟫_ℂ • (S T) (R (b i))) : by {simp only [is_R_or_C.inner_apply,
--  inner_product_space.is_self_adjoint.apply_eigenvector_basis,
--  pi_Lp.inner_apply,
--  eq_self_iff_true,
--  complex.coe_smul,
--  linear_isometry.map_smul,
--  finset.sum_congr]},
--         end,
--     rw ← hₛ at eq₂,
--     rw eq₂,
--     have Sb_eq_f : ∀ i : (fin n),  (S T) (b i) = f i :=
--     begin
--       intro i,
--       rw basis.mk_apply hli hsp i,
--     end,
--     conv
--     {
--       to_lhs,
--       congr,
--       skip,
--       funext,
--       rw inner_product_space.is_self_adjoint.apply_eigenvector_basis R_is_sa,
--       norm_cast,
--       rw ← complex.coe_smul,
--       rw linear_isometry.map_smul (S T),
--       rw Sb_eq_f,
--     },
--     congr',
--     ext1,
--     have eq₃ : (ring_hom.id ℂ) ↑(R_is_sa.eigenvalues h_fin x) = singular_values T x :=
--     begin
--       simp only [complex.of_real_inj, ring_hom.id_apply],
--       unfold singular_values,
--     end,
--     simp only [is_R_or_C.inner_apply, basis.coe_mk, complex.coe_smul, finset.sum_congr],
--     rw smul_comm,
--     simp only [singular_values],
--   end


import sylow.cyclic_vector_action
import sylow.card_of_list

/-!
# Cauchy's Theorem.

https://en.wikipedia.org/wiki/Cauchy%27s_theorem_(group_theory)

If a finite group $G$ has order a multiple of $p$ then
$G$ has an element of order $p$.

# Main Definitions.

## variables

(G : Type)
[group G]
(n : ℕ)

-/

namespace mygroup

open_locale classical
open mygroup.subgroup list mygroup.group

universes u v w
variables {G : Type} [group G]

--local attribute [instance, priority 10] subtype.fintype set_fintype classical.prop_decidable

/- want to prove the theorem that says
   that if p | |G| then G has an element of order p

   Proposed proof:

1) Let X be the set of lists of p elements of G whose product is 1
  -- a definition and hence a stroke of genius.
  -- Status : DONE
2) Note that cyclic shift is a permutation of X
3) Note that #X=|G|^{p-1} is a multiple of p
4) Hence # fixed point is a multiple of p by some standard theorem
5) and # fixed points is at least 1 (the identity)
6) so it's at least 2 and there's an element of order p

-/

-- #check array -- for computing

--lemma group.mul_left_inj : ∀ (a b c : G), b * a = c * a ↔ b = c :=
--mul_right_cancel_iff

--lemma group.inv_mul_self (a : G) : a⁻¹ * a = 1 := group.mul_left_inv a

--instance : is_associative G (*) := ⟨group.mul_assoc⟩

open list

theorem cauchy_elements (G : Type) [group G] [fintype G] (p : ℕ) (hp : p.prime)
  (hpG : p ∣ fincard G) : p ∣ fincard {g : G // g ^ (p : ℤ) = 1} :=
begin
  cases p with n, rcases hp with ⟨⟨⟩, _⟩,
  have h := card_set_congr_card_fixed_points_mod_prime (cool_action G n) n.succ hp 1,
  have h2 : fincard (cyclic ↑(n.succ)) = n.succ ^ 1,
    rw [nat.pow_one, cyclic.fincard_cyclic], simp,
  specialize h h2, rw card_cool_set at h,
  cases n with m, cases hp, cases hp_left, cases hp_left_a,
  have h1 : m.succ.succ ∣ fincard G ^ m.succ,
    rw nat.pow_succ,
    apply dvd_mul_of_dvd_right hpG,
  rw ←nat.modeq.modeq_zero_iff at h1 ⊢,
  have h2 := nat.modeq.trans (nat.modeq.symm h) h1,
  convert h2 using 1,
  have h3 := fixed_points_eq_roots G m.succ,
  exact fincard.of_equiv h3.symm
end

theorem cauchy_element (G : Type) [group G] [fintype G] (p : ℕ) (hp : p.prime)
  (hpG : p ∣ fincard G) : ∃ g : G, g ≠ 1 ∧ g  ^ (p : ℤ) = 1 :=
begin
  by_contra h, push_neg at h,
  have h1 : ∀ g : G, g ^ (p : ℤ) = 1 ↔ g = 1,
    intro g, split,
      { rintro h3, by_contra h2, exact h g h2 h3 },
      { rintro rfl, simp },
  have h2 := cauchy_elements G p hp hpG,
  let e : {g : G // g ^ (p : ℤ) = 1} ≃ {g : G // g = 1} :=
    { to_fun := λ g, ⟨g.1, (h1 g).1 g.2⟩,
      inv_fun := λ g, ⟨g.1, (h1 g).2 g.2⟩,
      left_inv := by {intro g, cases g, simp},
      right_inv := by {intro g, cases g, simp} },
  rw fincard.of_equiv e at h2,
  change p ∣ fincard ({(1 : G)} : set G) at h2,
  rw [fincard.card_singleton_eq_one, nat.dvd_one] at h2,
  subst h2, cases hp, cases hp_left, cases hp_left_a,
end

-- theorem prime_lemma (G : Type) [group G] (p : ℕ) (hp : p.prime) (g : G)
--   (hg1 : g ≠ 1) (hg2 : ⦃p⦄^g = 1) :
--   (group_hom.kernel (to_hom_cyclic g p hg2)).to_subgroup = ⊥ :=
-- begin
--   sorry
-- end

theorem order_map_image_eq (g : G) : (order_map g).image = closure {g} :=
begin
  rw cyclic.closure_singleton_eq,
  ext, split; rintro ⟨k, rfl⟩; exact ⟨k, rfl⟩,
end

-- theorem prime_lemma4 (G : Type) [group G] (p : ℕ) (hp : p.prime) (g : G)
--   (hg1 : g ≠ 1) (hg2 : ⦃p⦄^g = 1) : (order_map g).image = closure {g} := sorry

theorem gcd_lemma (g : G) (a b : ℕ) (ha : g ^ (a : ℤ) = 1) (hb : g ^ (b : ℤ) = 1) :
  g ^ (nat.gcd a b : ℤ) = 1 :=
begin
  rw [nat.gcd_eq_gcd_ab a b, group.pow_add, _root_.mul_comm, group.pow_mul, ha,
      group.one_pow, _root_.mul_comm, group.pow_mul, hb, group.one_pow, group.mul_one]
end

lemma group.inv_one : (1 : G)⁻¹ = 1 :=
begin
  symmetry,
  apply group.eq_inv_of_mul_eq_one,
  rw group.mul_one,
end

lemma easy (g : G) (a : ℤ) : g ^ (a : ℤ) = 1 ↔ g ^ (int.nat_abs a : ℤ) = 1 :=
begin
  cases int.nat_abs_eq a,
  { congr' },
  { conv_lhs { rw [h, group.pow_neg] },
    split,
      { intro h2,
        rw [← pow_inv, group.inv_eq] at h2,
        rw [← h2, group.inv_one] },
      { intro h2,
        rw [← pow_inv, group.inv_eq, h2, group.inv_one] } }
end

theorem int_gcd_lemma (g : G) (a b : ℤ)
  (ha : g ^ (a : ℤ) = 1) (hb : g ^ (b : ℤ) = 1) : g ^ (int.gcd a b : ℤ) = 1 :=
by apply gcd_lemma; rw ←easy; assumption

theorem aux_lemma1 {p : ℕ} (hp : p.prime) {g : G} (hg : g ≠ 1)
  (hpg : g ^ (p : ℤ) = 1) {k : ℤ} (hkg : g ^ (k : ℤ) = 1) : (p : ℤ) ∣ k :=
begin
  by_contra hk,
  set t := int.gcd p k with ht,
  have ht2 : t = 1,
    have := nat.gcd_dvd (int.nat_abs p) (int.nat_abs k),
    unfold int.gcd at ht,
    rw ←ht at this,
    cases this with h3 h4,
    change t ∣ p at h3,
    rw nat.dvd_prime hp at h3,
    cases h3, exact h3,
    exfalso,
    apply hk,
    rw h3 at h4,
    exact int.coe_nat_dvd_left.mpr h4,
  apply hg,
  convert int_gcd_lemma g p k hpg hkg,
  rw [← ht, ht2, int.coe_nat_one, group.pow_one],
end

theorem aux_lemma2 (p : ℕ) (hp : p.prime) (g : G)
  (hg1 : g ≠ 1) (hg2 : g ^ (p : ℤ) = 1) : (order_map g).kernel = mod ↑p :=
begin
  ext x, rw group_hom.mem_kernel, split; intro hx,
    { exact aux_lemma1 hp hg1 hg2 hx },
    { rcases hx with ⟨k, rfl⟩,
      change g ^ (p * k : ℤ) = _,
      rw [int.mul_comm, group.pow_mul, hg2, group.one_pow] }
end

def eq_equiv (G : Type) [group G] (H K : subgroup G) (i : H = K) : H ≃ K :=
{ to_fun := λ h, ⟨h.1, i ▸ h.2⟩,
  inv_fun := λ k, ⟨k.1, i.symm ▸ k.2⟩,
  left_inv := λ h, by ext; refl,
  right_inv := λ k, by ext; refl }

theorem key_lemma (G : Type) [group G] (p : ℕ) (hp : p.prime) (g : G)
  (hg1 : g ≠ 1) (hg2 : g ^ (p : ℤ) = 1) :
  fincard (closure ({g} : set G)) = p :=
begin
  have h := quotient.kernel_iso_image (order_map g),
  rw fincard.of_equiv (eq_equiv G _ _ (order_map_image_eq g).symm),
  have h2 := group_hom.mul_equiv_of_iso h,
  replace h2 := mul_equiv.to_equiv h2,
  rw fincard.of_equiv h2.symm,
  convert cyclic.fincard_cyclic p,
  apply aux_lemma2 p hp g hg1 hg2,
end

theorem cauchy (G : Type) [group G] [fintype G] (p : ℕ) (hp : p.prime)
  (hpG : p ∣ fincard G) : ∃ H : subgroup G, fincard H = p :=
begin
  rcases cauchy_element G p hp hpG with ⟨g, hg1, hg2⟩,
  use closure {g},
  apply key_lemma G p hp g hg1 hg2
end

end mygroup


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.star.algebra
import algebra.algebra.ordered
import analysis.special_functions.pow

/-!
# The Clauser-Horne-Shimony-Holt inequality and Tsirelson's inequality.

We establish a version of the Clauser-Horne-Shimony-Holt (CHSH) inequality
(which is a generalization of Bell's inequality).
This is a foundational result which implies that
quantum mechanics is not a local hidden variable theory.

As usually stated the CHSH inequality requires substantial language from physics and probability,
but it is possible to give a statement that is purely about ordered `*`-algebras.
We do that here, to avoid as many practical and logical dependencies as possible.
Since the algebra of observables of any quantum system is an ordered `*`-algebra
(in particular a von Neumann algebra) this is a strict generalization of the usual statement.

Let `R` be a `*`-ring.

A CHSH tuple in `R` consists of
* four elements `A₀ A₁ B₀ B₁ : R`, such that
* each `Aᵢ` and `Bⱼ` is a self-adjoint involution, and
* the `Aᵢ` commute with the `Bⱼ`.

The physical interpretation is that the four elements are observables (hence self-adjoint)
that take values ±1 (hence involutions), and that the `Aᵢ` are spacelike separated from the `Bⱼ`
(and hence commute).

The CHSH inequality says that when `R` is an ordered `*`-ring
(that is, a `*`-ring which is ordered, and for every `r : R`, `0 ≤ star r * r`),
which is moreover *commutative*, we have
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2`

On the other hand, Tsirelson's inequality says that for any ordered `*`-ring we have
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2√2`

(A caveat: in the commutative case we need 2⁻¹ in the ring,
and in the noncommutative case we need √2 and √2⁻¹.
To keep things simple we just assume our rings are ℝ-algebras.)

The proofs I've seen in the literature either
assume a significant framework for quantum mechanics,
or assume the ring is a `C^*`-algebra.
In the `C^*`-algebra case,
the order structure is completely determined by the `*`-algebra structure:
`0 ≤ A` iff there exists some `B` so `A = star B * B`.
There's a nice proof of both bounds in this setting at
https://en.wikipedia.org/wiki/Tsirelson%27s_bound
The proof given here is purely algebraic.

## Future work

One can show that Tsirelson's inequality is tight.
In the `*`-ring of n-by-n complex matrices, if `A ≤ λ I` for some `λ : ℝ`,
then every eigenvalue has absolute value at most `λ`.
There is a CHSH tuple in 4-by-4 matrices such that
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁` has `2√2` as an eigenvalue.

## References

* [Clauser, Horne, Shimony, Holt,
  *Proposed experiment to test local hidden-variable theories*][zbMATH06785026]
* [Bell, *On the Einstein Podolsky Rosen Paradox*][MR3790629]
* [Tsirelson, *Quantum generalizations of Bell's inequality*][MR577178]

-/

universes u

/--
A CHSH tuple in a `star_monoid R` consists of 4 self-adjoint involutions `A₀ A₁ B₀ B₁` such that
the `Aᵢ` commute with the `Bⱼ`.

The physical interpretation is that `A₀` and `A₁` are a pair of boolean observables which
are spacelike separated from another pair `B₀` and `B₁` of boolean observables.
-/
@[nolint has_inhabited_instance]
structure is_CHSH_tuple {R} [monoid R] [star_monoid R] (A₀ A₁ B₀ B₁ : R) :=
(A₀_inv : A₀^2 = 1) (A₁_inv : A₁^2 = 1) (B₀_inv : B₀^2 = 1) (B₁_inv : B₁^2 = 1)
(A₀_sa : star A₀ = A₀) (A₁_sa : star A₁ = A₁) (B₀_sa : star B₀ = B₀) (B₁_sa : star B₁ = B₁)
(A₀B₀_commutes : A₀ * B₀ = B₀ * A₀)
(A₀B₁_commutes : A₀ * B₁ = B₁ * A₀)
(A₁B₀_commutes : A₁ * B₀ = B₀ * A₁)
(A₁B₁_commutes : A₁ * B₁ = B₁ * A₁)

variables {R : Type u}

/--
Given a CHSH tuple (A₀, A₁, B₀, B₁) in a *commutative* ordered `*`-algebra over ℝ,
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2`.

(We could work over ℤ[⅟2] if we wanted to!)
-/
lemma CHSH_inequality_of_comm
  [ordered_comm_ring R] [star_ordered_ring R] [algebra ℝ R] [ordered_module ℝ R]
  (A₀ A₁ B₀ B₁ : R) (T : is_CHSH_tuple A₀ A₁ B₀ B₁) :
  A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2 :=
begin
  let P := (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁),
  have i₁ : 0 ≤ P,
  { have idem : P * P = 4 * P,
    { -- If we had a Gröbner basis algorithm, this would be trivial.
      -- Without one, it is somewhat tedious!
      dsimp [P],
      simp only [add_mul, mul_add, sub_mul, mul_sub, mul_comm, mul_assoc, add_assoc],
      repeat { conv in (B₀ * (A₀ * B₀))
      { rw [T.A₀B₀_commutes, ←mul_assoc B₀ B₀ A₀, ←sq, T.B₀_inv, one_mul], } },
      repeat { conv in (B₀ * (A₁ * B₀))
      { rw [T.A₁B₀_commutes, ←mul_assoc B₀ B₀ A₁, ←sq, T.B₀_inv, one_mul], } },
      repeat { conv in (B₁ * (A₀ * B₁))
      { rw [T.A₀B₁_commutes, ←mul_assoc B₁ B₁ A₀, ←sq, T.B₁_inv, one_mul], } },
      repeat { conv in (B₁ * (A₁ * B₁))
      { rw [T.A₁B₁_commutes, ←mul_assoc B₁ B₁ A₁, ←sq, T.B₁_inv, one_mul], } },
      conv in (A₀ * (B₀ * (A₀ * B₁)))
      { rw [←mul_assoc, T.A₀B₀_commutes, mul_assoc, ←mul_assoc A₀, ←sq, T.A₀_inv, one_mul], },
      conv in (A₀ * (B₁ * (A₀ * B₀)))
      { rw [←mul_assoc, T.A₀B₁_commutes, mul_assoc, ←mul_assoc A₀, ←sq, T.A₀_inv, one_mul], },
      conv in (A₁ * (B₀ * (A₁ * B₁)))
      { rw [←mul_assoc, T.A₁B₀_commutes, mul_assoc, ←mul_assoc A₁, ←sq, T.A₁_inv, one_mul], },
      conv in (A₁ * (B₁ * (A₁ * B₀)))
      { rw [←mul_assoc, T.A₁B₁_commutes, mul_assoc, ←mul_assoc A₁, ←sq, T.A₁_inv, one_mul], },
      simp only [←sq, T.A₀_inv, T.A₁_inv],
      simp only [mul_comm A₁ A₀, mul_comm B₁ B₀, mul_left_comm A₁ A₀, mul_left_comm B₁ B₀,
        mul_left_comm B₀ A₀, mul_left_comm B₀ A₁, mul_left_comm B₁ A₀, mul_left_comm B₁ A₁],
      norm_num,
      simp only [mul_comm _ (2 : R), mul_comm _ (4 : R),
        mul_left_comm _ (2 : R), mul_left_comm _ (4 : R)],
      abel,
      simp only [neg_mul_eq_neg_mul_symm, mul_one, int.cast_bit0, one_mul, int.cast_one,
        gsmul_eq_mul, int.cast_neg],
      simp only [←mul_assoc, ←add_assoc],
      norm_num, },
    have idem' : P = (1 / 4 : ℝ) • (P * P),
    { have h : 4 * P = (4 : ℝ) • P := by simp [algebra.smul_def],
      rw [idem, h, ←mul_smul],
      norm_num, },
    have sa : star P = P,
    { dsimp [P],
      simp only [star_add, star_sub, star_mul, star_bit0, star_one,
        T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa, mul_comm B₀, mul_comm B₁], },
    rw idem',
    conv_rhs { congr, skip, congr, rw ←sa, },
    convert smul_le_smul_of_nonneg (star_mul_self_nonneg : 0 ≤ star P * P) _,
    { simp, },
    { apply_instance, },
    { norm_num, }, },
  apply le_of_sub_nonneg,
  simpa only [sub_add_eq_sub_sub, ←sub_add] using i₁,
end

/-!
We now prove some rather specialized lemmas in preparation for the Tsirelson inequality,
which we hide in a namespace as they are unlikely to be useful elsewhere.
-/
local notation `√2` := (real.sqrt 2 : ℝ)

namespace tsirelson_inequality

/-!
Before proving Tsirelson's bound,
we prepare some easy lemmas about √2.
-/

-- This calculation, which we need for Tsirelson's bound,
-- defeated me. Thanks for the rescue from Shing Tak Lam!
lemma tsirelson_inequality_aux : √2 * √2 ^ 3 = √2 * (2 * √2⁻¹ + 4 * (√2⁻¹ * 2⁻¹)) :=
begin
  ring_nf,
  rw [mul_assoc, inv_mul_cancel, real.sqrt_eq_rpow, ←real.rpow_nat_cast, ←real.rpow_mul],
  { norm_num,
    rw show (2 : ℝ) ^ (2 : ℝ) = (2 : ℝ) ^ (2 : ℕ), by { rw ←real.rpow_nat_cast, norm_num },
    norm_num },
  { norm_num, },
  { norm_num, },
end

lemma sqrt_two_inv_mul_self : √2⁻¹ * √2⁻¹ = (2⁻¹ : ℝ) :=
by { rw [←mul_inv'], norm_num, }

end tsirelson_inequality
open tsirelson_inequality

/--
In a noncommutative ordered `*`-algebra over ℝ,
Tsirelson's bound for a CHSH tuple (A₀, A₁, B₀, B₁) is
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2^(3/2) • 1`.

We prove this by providing an explicit sum-of-squares decomposition
of the difference.

(We could work over `ℤ[2^(1/2), 2^(-1/2)]` if we really wanted to!)
-/
lemma tsirelson_inequality
  [ordered_ring R] [star_ordered_ring R]
  [algebra ℝ R] [ordered_module ℝ R] [star_algebra ℝ R]
  (A₀ A₁ B₀ B₁ : R) (T : is_CHSH_tuple A₀ A₁ B₀ B₁) :
  A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ √2^3 • 1 :=
begin
  -- abel will create `ℤ` multiplication. We will `simp` them away to `ℝ` multiplication.
  have M : ∀ (m : ℤ) (a : ℝ) (x : R), m • a • x = ((m : ℝ) * a) • x :=
    λ m a x, by rw [gsmul_eq_smul_cast ℝ, ← mul_smul],
  let P := √2⁻¹ • (A₁ + A₀) - B₀,
  let Q := √2⁻¹ • (A₁ - A₀) + B₁,
  have w : √2^3 • 1 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁ = √2⁻¹ • (P^2 + Q^2),
  { dsimp [P, Q],
    -- distribute out all the powers and products appearing on the RHS
    simp only [sq, sub_mul, mul_sub, add_mul, mul_add, smul_add, smul_sub],
    -- pull all coefficients out to the front, and combine `√2`s where possible
    simp only [algebra.mul_smul_comm, algebra.smul_mul_assoc, ←mul_smul, sqrt_two_inv_mul_self],
    -- replace Aᵢ * Aᵢ = 1 and Bᵢ * Bᵢ = 1
    simp only [←sq, T.A₀_inv, T.A₁_inv, T.B₀_inv, T.B₁_inv],
    -- move Aᵢ to the left of Bᵢ
    simp only [←T.A₀B₀_commutes, ←T.A₀B₁_commutes, ←T.A₁B₀_commutes, ←T.A₁B₁_commutes],
    -- collect terms, simplify coefficients, and collect terms again:
    abel,
    -- all terms coincide, but the last one. Simplify all other terms
    simp only [M],
    simp only [neg_mul_eq_neg_mul_symm, int.cast_bit0, one_mul, mul_inv_cancel_of_invertible,
      int.cast_one, one_smul, int.cast_neg, add_right_inj, neg_smul, ← add_smul],
    -- just look at the coefficients now:
    congr,
    exact mul_left_cancel' (by norm_num) tsirelson_inequality_aux, },
  have pos : 0 ≤ √2⁻¹ • (P^2 + Q^2), {
    have P_sa : star P = P,
    { dsimp [P],
      simp only [star_smul, star_add, star_sub, star_id_of_comm,
        T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa], },
    have Q_sa : star Q = Q,
    { dsimp [Q],
      simp only [star_smul, star_add, star_sub, star_id_of_comm,
        T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa], },
    have P2_nonneg : 0 ≤ P^2,
    { rw [sq],
      conv { congr, skip, congr, rw ←P_sa, },
      convert (star_mul_self_nonneg : 0 ≤ star P * P), },
    have Q2_nonneg : 0 ≤ Q^2,
    { rw [sq],
      conv { congr, skip, congr, rw ←Q_sa, },
      convert (star_mul_self_nonneg : 0 ≤ star Q * Q), },
    convert smul_le_smul_of_nonneg (add_nonneg P2_nonneg Q2_nonneg)
      (le_of_lt (show 0 < √2⁻¹, by norm_num)), -- `norm_num` can't directly show `0 ≤ √2⁻¹`
    simp, },
  apply le_of_sub_nonneg,
  simpa only [sub_add_eq_sub_sub, ←sub_add, w] using pos,
end


import topology.bounded_continuous_function
import assumptions

noncomputable theory
open set classical
local attribute [instance] prop_decidable

variables {X : Type*} [metric_space X] [compact_space X]

-- We adopt the notation of bounded countinuous function from mathlib
local infixr ` →ᵇ ` : 25 := bounded_continuous_function

lemma closure₂_of_univ :
closure₂ (@univ (X →ᵇ ℝ)) = univ :=
begin
  ext f, split; intro hf,
    { exact mem_univ f },
    { left, refine ⟨f, f, hf, hf, or.inl _⟩,
      unfold has_sup.sup,
      ext, simpa }
end

/- The first lemma we need states that:

f ∈ closure₂ M₀ ↔
∀ x, y ∈ X, ∀ ε > 0, ∃ f' ∈ closure₀ M₀, such that
|f(x) - f'(x)| < ε and |f(y) - f'(y)| < ε -/

/- The forward direction is trivial -/
lemma dense_at_points_in_closure
{M₀ : set (X →ᵇ ℝ)} {f : X →ᵇ ℝ} (h : f ∈ closure₂ M₀) :
∀ ε > 0, ∀ x y : X, ∃ (g : X →ᵇ ℝ) (H : g ∈ closure₀ M₀),
abs (f x - g x) < ε ∧ abs (f y - g y) < ε :=
begin
  rcases h with ⟨g, h, hg, hh, h⟩; intros ε hε x y,
    { cases h with hlub hglb,
        exact ⟨g ⊔ h, ⟨g, h, hg, hh, or.inl rfl⟩, by simpa [hlub, hε]⟩,
        exact ⟨g ⊓ h, ⟨g, h, hg, hh, or.inr rfl⟩, by simpa [hglb, hε]⟩ },
    { rcases h with ⟨F, hF, hlim⟩,
      cases hlim ε hε with N hN,
      exact ⟨F N, hF N, by simp [hN N (le_refl N)]⟩ }
end

/- To prove the reverse we fix x ∈ X and vary y.

Since X is a compact space, We an use Heine-Borel on the entire space.

This is the lemma we'll use: compact.elim_finite_subcover -/

/- So let us fix x ∈ X and given y ∈ X write the function g satisfying
h : abs (f(x) - g(x)) < ε ∧ abs (f(y) - g(y)) < ε, f_y (the existence
of which is guarenteed by our hypothesis), we define
  S(y) := {z ∈ X | f(z) - f_y(z) < ε}
It's obvious that y ∈ S(y) by h.right so
  X ⊆ ⋃ (y : X) S(y) ⇒ X = ⋃ (y : X) S(y)

Now as X is compact, there is a finite subcover of X so there exists
points in X, y₁, ⋯, yₙ, such that
  X = U i ∈ {1, ⋯, n}, S(yᵢ).

So now, by letting g_x := ⊔ i, f_yᵢ, we have ∀ z ∈ X,
  g_x(z) ≥ f_yₖ(z) > f(z) - ε
for some k ∈ {1, ⋯, n}.

Now we will define T(x) := {z ∈ X | g_x(z) < f(z) + ε}.
As ∀ yᵢ, f_yᵢ(x) < f(x) + ε by h.left, so is g_x(x) < f(x) + ε.
Thus, x ∈ T(x) and X ⊆ ⋃ (x : X) T(x) and again as X is compact, there
is x₁, ⋯, xₘ, such that
  X = U i ∈ {1, ⋯, m}, S(xᵢ).

So, by letting h := ⊓ i, g_xᵢ, we have ∀ z ∈ X, h(z) ≤ g_xₖ(z) < f(z) + ε.
Now, as g_xᵢ(z) > f(z) - ε, for all i, so is h(z) > f(z) - ε and hence
there is a function in closure₀ M₀ thats arbitarily close to f.
-/

/- Given x ∈ X, we create a function thats greater than f(z) - ε at all z while
smaller than f(x) + ε. -/
lemma has_bcf_gt {M₀ : set (X →ᵇ ℝ)} {f : X →ᵇ ℝ}
(h : ∀ ε > 0, ∀ x y : X, ∃ (g : X →ᵇ ℝ)
(H : g ∈ closure₀ M₀), abs (f x - g x) < ε ∧ abs (f y - g y) < ε) :
∀ ε > 0, ∀ x : X, ∃ (g : X →ᵇ ℝ)
(H : g ∈ closure₀ M₀), ∀ z : X, f z - ε < g z ∧ g x < f x + ε :=
begin
  intros ε hε x, choose g hg₀ hg₁ using h ε (by {norm_cast, exact hε}) x,
  let S : X → set X := λ y, {z | f z - g y z < ε},
  cases compact.elim_finite_subcover _inst_2.1 S
    (is_open_aux_set₀ (by norm_cast; exact hε)) _ with I hI,
    { let p := I.sup g,
      refine ⟨p, finset_sup_mem_closure₀ hg₀,
        λ z, ⟨_, finset_sup_lt (λ i hi, by linarith [(abs_lt.1 (hg₁ i).1).1])⟩⟩,
        suffices : ∃ i ∈ I, f z - ε < g i z,
            rcases this with ⟨i, hi₀, hi₁⟩,
            exact lt_of_lt_of_le hi₁ (le_finset_sup g i hi₀ z),
        have : z ∈ ⋃ (i : X) (H : i ∈ I), S i, exact hI (by trivial),
        cases mem_Union.1 this with i hi, cases mem_Union.1 hi with hi hz,
        rw mem_set_of_eq at hz, exact ⟨i, hi, by linarith⟩ },
    { intros y hy, exact mem_Union.2 ⟨y, (abs_lt.1 (hg₁ y).2).2⟩ }
end

/- We again use the same method obtaining a function arbitarily close to f -/
lemma has_bcf_close {M₀ : set (X →ᵇ ℝ)} {f : X →ᵇ ℝ}
(h : ∀ ε > 0, ∀ x y : X, ∃ (g : X →ᵇ ℝ)
(H : g ∈ closure₀ M₀), abs (f x - g x) < ε ∧ abs (f y - g y) < ε) :
∀ (ε : ℝ) (hε : 0 < ε), ∃ (g : X →ᵇ ℝ)
(H : g ∈ closure₀ M₀), ∀ z : X, abs (f z - g z) < ε :=
begin
  intros ε hε, choose g hg₀ hg₁ using has_bcf_gt h ε hε,
  let S : X → set X := λ x, {z | g x z < f z + ε},
  cases compact.elim_finite_subcover _inst_2.1 S (is_open_aux_set₁ hε) _ with I hI,
    { let p := I.inf g, refine ⟨p, finset_inf_mem_closure₀ hg₀, λ z, _⟩,
      rw abs_lt, refine ⟨_, _⟩,
        { rw neg_lt_sub_iff_lt_add,
          suffices : ∃ i ∈ I, g i z < f z + ε,
            rcases this with ⟨i, hi₀, hi₁⟩,
            refine lt_of_le_of_lt (finset_inf_le g i hi₀ z) hi₁,
          have : z ∈ ⋃ (i : X) (H : i ∈ I), S i, refine hI (by trivial),
          cases mem_Union.1 this with i hi, cases mem_Union.1 hi with hi hz,
          refine ⟨i, hi, hz⟩ },
        { suffices : ∀ i ∈ I, f z - ε < g i z,
            exact sub_lt.2 (lt_finset_inf this),
          intros i hi, exact (hg₁ i z).1 } },
    { intros x hx, exact mem_Union.2 ⟨x, (hg₁ x x).2⟩ }
end

/- With that we conclude that there is some sequence of functions in closure₀ M₀
that is uniformly convergent towards f -/
lemma in_closure₂_of_dense_at_points {M₀ : set (X →ᵇ ℝ)} {f : X →ᵇ ℝ}
(h : ∀ ε > 0, ∀ x y : X, ∃ (g : X →ᵇ ℝ)
(H : g ∈ closure₀ M₀), abs (f x - g x) < ε ∧ abs (f y - g y) < ε) :
f ∈ closure₂ M₀ := or.inr $
begin
  choose F hF₀ hF₁ using λ (n : ℕ),
    has_bcf_close h (1 / (n + 1)) (nat.one_div_pos_of_nat),
  refine ⟨F, hF₀, λ ε hε, _⟩,
  cases exists_nat_gt (1 / ε) with N hN,
  refine ⟨N, λ n hn x, lt_of_lt_of_le (hF₁ n x) $
    one_div_le_of_one_div_le_of_pos hε $ le_trans (le_of_lt hN) _⟩,
  norm_cast, exact le_add_right hn,
end

/- Finally, we can conclude that f can be constructed from M₀ using inf, sup
and uniform convergence iff. for all pairs of points in X, (x, y), there is
some sequence of functions in M₀ that converges pointwise to f(x) and f(y) at
x and y. -/
theorem in_closure₂_iff_dense_at_points {M₀ : set (X →ᵇ ℝ)} {f : X →ᵇ ℝ} :
f ∈ closure₂ M₀ ↔ ∀ ε > 0, ∀ x y : X,
∃ (g : X →ᵇ ℝ) (H : g ∈ closure₀ M₀), abs (f x - g x) < ε ∧ abs (f y - g y) < ε :=
⟨λ h, dense_at_points_in_closure h, λ h, in_closure₂_of_dense_at_points h⟩

/- From this, a corollaries can be deduced immediately:

- If ∀ x, y ∈ X, a, b ∈ ℝ, ∃ f ∈ M₀, f(x) = a, f(y) = b, then
  closure₂ M₀ = M (= @univ X →ᵇ ℝ)
where M is the set of all bounded continuous functions from X to ℝ. -/

/- Due to reasons commented from above, we will now consider pairs of points in
X rather than functions.

We define M₀' : X → X → ℝ × ℝ : x, y ↦ {(f(x), f(y)) | f ∈ M₀};
    (α, β) ⊔ (γ, δ) := (max α γ, max β δ);
and (α, β) ⊓ (γ, δ) := (min α γ, min β δ).

We also define a closure with respect to this inf, sup and limits of
sequences in ℝ². -/

lemma le_closure' {S : set (ℝ × ℝ)} : S ⊆ closure' S :=
begin
  intros x hx, left, refine ⟨x, x, hx, hx, or.inl _⟩,
  unfold has_sup.sup,
  unfold semilattice_sup.sup,
  unfold lattice.sup,
  simp
end

lemma zero_mem_of_subalgebra {M₀' : subalgebra ℝ (X →ᵇ ℝ)} :
(0 : X →ᵇ ℝ) ∈ M₀'.carrier := M₀'.2.1.1.1

lemma one_mem_of_subalgebra {M₀' : subalgebra ℝ (X →ᵇ ℝ)} :
(1 : X →ᵇ ℝ) ∈ M₀'.carrier := M₀'.2.2.1

lemma neg_mem_of_subalgebra {M₀' : subalgebra ℝ (X →ᵇ ℝ)} :
∀ f ∈ M₀'.carrier, -f ∈ M₀'.carrier := M₀'.2.1.2

lemma add_mem_of_subalgebra {M₀' : subalgebra ℝ (X →ᵇ ℝ)} :
∀ f g ∈ M₀'.carrier, f + g ∈ M₀'.carrier := M₀'.2.1.1.2

lemma mul_mem_of_subalgebra {M₀' : subalgebra ℝ (X →ᵇ ℝ)} :
∀ f g ∈ M₀'.carrier, f * g ∈ M₀'.carrier := M₀'.2.2.2

lemma zero_mem_of_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
(0 : ℝ × ℝ) ∈ boundary_points (closure₂ M₀'.carrier) x y :=
begin
  refine ⟨(0 : X →ᵇ ℝ), _, _⟩,
  apply closure_le_seq₁, rw hc,
  exact zero_mem_of_subalgebra,
  refl
end

lemma one_mem_of_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
(1 : ℝ × ℝ) ∈ boundary_points (closure₂ M₀'.carrier) x y :=
begin
  refine ⟨(1 : X →ᵇ ℝ), _, _⟩,
  apply closure_le_seq₁, rw hc,
  exact one_mem_of_subalgebra,
  refl
end

/- neg_mem is a bit trickier since we need to show that closure₂
is closed under neg (note that we are not assuming closure₂ M₀ is
a subalgebra). To prove this we construct an uniformly convergent sequence
of functions in M₀ that converges to -f. -/
lemma neg_mem_of_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
∀ β ∈ boundary_points (closure₂ M₀'.carrier) x y,
-β ∈ boundary_points (closure₂ M₀'.carrier) x y :=
begin
  intros β hβ, rcases hβ with ⟨f, hf₀, hf₁⟩,
  refine ⟨-f, _, _⟩,
  cases hf₀,
    { rcases hf₀ with ⟨g, h, hg, hh, hgh⟩,
      cases hgh; left,
      refine ⟨-g, -h, neg_mem_of_subalgebra g hg, neg_mem_of_subalgebra h hh, _⟩,
      right, exact neg_inf_eq_sup.1 hgh,
      refine ⟨-g, -h, neg_mem_of_subalgebra g hg, neg_mem_of_subalgebra h hh, _⟩,
      left, exact neg_sup_eq_inf.1 hgh },
    { rcases hf₀ with ⟨F, hF₀, hF₁⟩,
      right,
      refine ⟨λ n, -F n, λ i, _, _⟩,
      rw hc at *, exact neg_mem_of_subalgebra (F i) (hF₀ i),
      exact neg_unif_converges_to hF₁ },
    rw ←hf₁, refl
end

/- It is a similar story for add_mem and mul_mem. These requires
- if λ n, F n ⟶ f and λ n, G n ⟶ g, then λ n, F n + G n ⟶ f + g
- if λ n, F n ⟶ f and λ n, G n ⟶ g, then λ n, F n * G n ⟶ f * g
respectively (both of which are standar results so).
-/
lemma add_mem_of_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
∀ β γ ∈ boundary_points (closure₂ M₀'.carrier) x y,
β + γ ∈ boundary_points (closure₂ M₀'.carrier) x y := sorry

lemma mul_mem_of_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
∀ β γ ∈ boundary_points (closure₂ M₀'.carrier) x y,
β * γ ∈ boundary_points (closure₂ M₀'.carrier) x y := sorry

/- The boundary points of a closed subalgebra of (X →ᵇ ℝ) over ℝ
form a subring. -/
lemma is_subring_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
is_subring (boundary_points (closure₂ M₀'.carrier) x y) :=
{ zero_mem := zero_mem_of_boundary_points hc,
  add_mem := add_mem_of_boundary_points hc,
  neg_mem := neg_mem_of_boundary_points hc,
  one_mem := one_mem_of_boundary_points hc,
  mul_mem := mul_mem_of_boundary_points hc }

lemma boundary_points_range_le {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
{x y} (hc : closure₀ M₀'.carrier = M₀'.carrier) :
range (algebra_map ℝ (ℝ × ℝ)) ≤ boundary_points (closure₂ M₀'.carrier) x y :=
begin
  intros z hz, cases mem_range.1 hz with r hr,
  refine ⟨r • 1, _, _⟩,
  apply closure_le_seq₁, rw hc,
  exact subalgebra_closed_under_smul' r one_mem_of_subalgebra,
  suffices : (r, r) = z,
    simpa [show ∀ x, (1 : X →ᵇ ℝ) x = 1, by intro z; refl],
  rw ←hr, refl
end

/- With that, we can construct a subalgebra of ℝ² with underlying
set being boundary_points (closure₂ M₀'.carrier) x y-/
def subalgebra_of_boundary_points {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
(x y) (hc : closure₀ M₀'.carrier = M₀'.carrier) :
  subalgebra ℝ (ℝ × ℝ) :=
{ carrier := boundary_points (closure₂ M₀'.carrier) x y,
  subring := is_subring_boundary_points hc,
  range_le' := boundary_points_range_le hc}

lemma in_closure'_of_in_closoure₂ {M₀' : subalgebra ℝ (X →ᵇ ℝ)} {f : X →ᵇ ℝ}
(h : f ∈ closure₂ M₀'.carrier) (hc : closure₀ M₀'.carrier = M₀'.carrier) :
∀ x y : X, x ≠ y → (f x, f y) ∈ closure' (boundary_points M₀'.carrier x y) :=
begin
  intros x y hxy, right,
  rw in_closure₂_iff_dense_at_points at h,
  choose F hF₀ hF₁ using λ (n : ℕ),
    h (1 / (n + 1)) (nat.one_div_pos_of_nat) x y,
  refine ⟨λ n, (F n x, F n y), λ n, ⟨F n, hc ▸ hF₀ n, rfl⟩, λ ε hε, _⟩,
  cases exists_nat_gt (1 / ε) with N hN,
  refine ⟨N, λ n hn, _⟩,
  suffices : abs (F n x - f x) < ε ∧ abs (F n y - f y) < ε,
    unfold dist, simp [this],
  split; rw abs_sub;
    try { refine lt_of_lt_of_le (hF₁ n).1 _ <|> refine lt_of_lt_of_le (hF₁ n).2 _ };
    refine one_div_le_of_one_div_le_of_pos hε (le_trans (le_of_lt hN) _);
    norm_cast; exact le_add_right hn
end

lemma bcf_pair_sup_eq_bcf_sup_pair {u v : X →ᵇ ℝ} {x y} :
(u x, u y) ⊔ (v x, v y) = ((u ⊔ v) x, (u ⊔ v) y) := rfl

lemma bcf_pair_inf_eq_bcf_inf_pair {u v : X →ᵇ ℝ} {x y} :
(u x, u y) ⊓ (v x, v y) = ((u ⊓ v) x, (u ⊓ v) y) := rfl

lemma one_mapsto_one {x} : (1 : X →ᵇ ℝ) x = 1 := rfl

lemma in_closure₂_of_in_closure' {M₀' : subalgebra ℝ (X →ᵇ ℝ)} {f : X →ᵇ ℝ}
(hc : closure₀ M₀'.carrier = M₀'.carrier)
(h : ∀ x y : X, x ≠ y → (f x, f y) ∈ closure' (boundary_points M₀'.carrier x y)) :
f ∈ closure₂ M₀'.carrier :=
begin
  rw in_closure₂_iff_dense_at_points,
  intros ε hε x y,
  cases em (x = y) with hxy hxy,
  have : (f x, f x) ∈ closure' (boundary_points M₀'.carrier x y),
    refine le_closure' ⟨(f x) • 1, _⟩,
    refine ⟨subalgebra_closed_under_smul' (f x) one_mem_of_subalgebra, _⟩,
    rw ←hxy, simp [one_mapsto_one],
  cases this with h' h',
    { rcases h' with ⟨r, t, ⟨u, hu₀, hu₁⟩, ⟨v, hv₀, hv₁⟩, hrt⟩,
      cases hrt, rw hc,
        { refine ⟨u ⊔ v, (hc ▸ closure₀_closed_with_sup) hu₀ hv₀, _⟩,
          rw [←hu₁, ←hv₁, bcf_pair_sup_eq_bcf_sup_pair] at hrt,
          rw [(prod.mk.inj hrt).1, (prod.mk.inj hrt).2, hxy], simpa },
        { refine ⟨u ⊓ v, closure₀_closed_with_inf _ _, _⟩;
          try { rw hc, assumption },
          rw [←hu₁, ←hv₁, bcf_pair_inf_eq_bcf_inf_pair] at hrt,
          rw [(prod.mk.inj hrt).1, (prod.mk.inj hrt).2, hxy], simpa } },
    { rcases h' with ⟨s, hs₀, hs₁⟩,
      cases hs₁ ε hε with N hN,
      rcases hs₀ N with ⟨g, hg₀, hg₁⟩,
      refine ⟨g, _, _⟩, rw hc, assumption,
      have := hN N (le_refl N),
      rw ←hg₁ at this, unfold dist at this, simp at this,
      split; rw [abs_sub]; simp only [this],
      convert this.2, rwa hxy },
  cases h x y hxy with h' h',
    { rcases h' with ⟨r, t, ⟨u, hu₀, hu₁⟩, ⟨v, hv₀, hv₁⟩, hrt⟩,
      cases hrt, rw hc,
        { refine ⟨u ⊔ v, (hc ▸ closure₀_closed_with_sup) hu₀ hv₀, _⟩,
          rw [←hu₁, ←hv₁, bcf_pair_sup_eq_bcf_sup_pair] at hrt,
          rw [(prod.mk.inj hrt).1, (prod.mk.inj hrt).2], simpa },
        { refine ⟨u ⊓ v, closure₀_closed_with_inf _ _, _⟩;
          try { rw hc, assumption },
          rw [←hu₁, ←hv₁, bcf_pair_inf_eq_bcf_inf_pair] at hrt,
          rw [(prod.mk.inj hrt).1, (prod.mk.inj hrt).2], simpa } },
    { rcases h' with ⟨s, hs₀, hs₁⟩,
      cases hs₁ ε hε with N hN,
      rcases hs₀ N with ⟨g, hg₀, hg₁⟩,
      refine ⟨g, _, _⟩, rw hc, assumption,
      have := hN N (le_refl N),
      rw ←hg₁ at this, unfold dist at this, simp at this,
      split; rw abs_sub; simp only [this] }
end

lemma in_closure₂_iff_in_closure' {M₀' : subalgebra ℝ (X →ᵇ ℝ)} {f : X →ᵇ ℝ}
(hc : closure₀ M₀'.carrier = M₀'.carrier) :
f ∈ closure₂ M₀'.carrier ↔
∀ x y : X, x ≠ y → (f x, f y) ∈ closure' (boundary_points M₀'.carrier x y) :=
⟨λ h, in_closure'_of_in_closoure₂ h hc, λ h, in_closure₂_of_in_closure' hc h⟩

/- With this, we can formulate the relation between M₀ and M₀'(x, y) formally, i.e.
if M₀, M₁ ⊆ M,
  hM : M₀ = closure₂ M₀ and M₁ = closure₂ M₁
  hb : ∀ x, y ∈ X, M₀*(x, y) = M₁*(x, y)
then M₀ = M₁. -/
lemma boundary_points_eq_of_eq (M₀' M₁' : subalgebra ℝ (X →ᵇ ℝ))
(h : M₀'.carrier = M₁'.carrier) :
∀ x y : X, x ≠ y → boundary_points M₀'.carrier x y = boundary_points M₁'.carrier x y :=
λ _ _ _, by rw h

lemma closure₀_eq_of_closure₂_eq {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
(h : closure₂ M₀'.carrier = M₀'.carrier) :
closure₀ M₀'.carrier = M₀'.carrier := sorry

lemma eq_of_boundary_points_eq (M₀' M₁' : subalgebra ℝ (X →ᵇ ℝ))
(h : ∀ x y : X, x ≠ y → boundary_points M₀'.carrier x y = boundary_points M₁'.carrier x y)
(hM₀ : M₀'.carrier = closure₂ M₀'.carrier)
(hM₁ : M₁'.carrier = closure₂ M₁'.carrier) : M₀'.carrier = M₁'.carrier :=
begin
  ext f, split; intro hf;
  { try {rw hM₀ <|> rw hM₁}, try {rw hM₀ at hf <|> rw hM₁ at hf},
    try { rw in_closure₂_iff_in_closure' (closure₀_eq_of_closure₂_eq hM₁.symm),
      rw in_closure₂_iff_in_closure' (closure₀_eq_of_closure₂_eq hM₀.symm) at hf },
    try { rw in_closure₂_iff_in_closure' (closure₀_eq_of_closure₂_eq hM₁.symm) at hf,
      rw in_closure₂_iff_in_closure' (closure₀_eq_of_closure₂_eq hM₀.symm) },
    intros x y hxy, try {rw ←h x y <|> rw h x y},
    exact hf x y hxy, assumption }
end

theorem eq_iff_boundary_points_eq (M₀' M₁' : subalgebra ℝ (X →ᵇ ℝ))
(hM₀ : M₀'.carrier = closure₂ M₀'.carrier)
(hM₁ : M₁'.carrier = closure₂ M₁'.carrier) :
M₀'.carrier = M₁'.carrier ↔
∀ x y : X, x ≠ y → boundary_points M₀'.carrier x y = boundary_points M₁'.carrier x y :=
⟨λ h, boundary_points_eq_of_eq _ _ h, λ h, eq_of_boundary_points_eq _ _ h hM₀ hM₁⟩

/- Now that we've reformulated the problem such that it considers points in ℝ²
rather than all bounded continuous functions, the question now becomes,
under what condition, is the boundary points of closure₂ M₀ equal to ℝ². -/
lemma closure₂_subalgebra_carrier {M₀' : subalgebra ℝ (X →ᵇ ℝ)} :
(closure₂_subalgebra M₀').carrier = closure₂ M₀'.carrier := rfl

lemma univ_subalgebra_carrier :
(univ_subalgebra.carrier : set (X →ᵇ ℝ)) = univ := rfl

theorem func_dense_iff_boundary_points_dense (M₀' : subalgebra ℝ (X →ᵇ ℝ)) :
closure₂ M₀'.carrier = univ ↔
∀ x y, x ≠ y → boundary_points (closure₂ M₀'.carrier) x y = univ :=
begin
  have := eq_iff_boundary_points_eq (closure₂_subalgebra M₀') univ_subalgebra
    (closure₂_of_closure₂ M₀'.carrier).symm (closure₂_of_univ).symm,
  rw [closure₂_subalgebra_carrier, univ_subalgebra_carrier] at this,
  split,
    { intros h x y hxy,
      rw this at h, rw (h x y),
      exact boundary_points_of_univ x y,
      assumption },
    { intro h, rw this, intros x y hxy, rw h x y,
      exact (boundary_points_of_univ x y).symm,
      assumption }
end

/- Now that we have proved that given a closed subalgebra of X →ᵇ ℝ over
ℝ - M₀', boundary_points (closure₂ M₀'.carrier) x y form a subalgebra of
ℝ², we can use this fact in combination of our theorem from ralgebra.lean
concluding boundary_points (closure₂ M₀'.carrier) x y must be
  {(0, 0)} ∨ {p | ∃ x : ℝ, p = (x, 0)} ∨
  {p | ∃ y : ℝ, p = (0, y)} ∨ {p | ∃ z : ℝ, p = (z, z)} ∨ ℝ²
Now due to `one_mem_of_boundary_points`, we eliminate our possiblities to
{p | ∃ z : ℝ, p = (z, z)} ∨ ℝ², the first of which is not possible if
we have seperate points. -/

/- (Weierstrass-Stone's Theorem)
Let M₀ be a subalgebra of (X →ᵇ ℝ) that's closed (M₂ = closure₀ M₀)
and seperate points. Then closure₂ M₀ = univ. -/
theorem weierstrass_stone {M₀' : subalgebra ℝ (X →ᵇ ℝ)}
(hc   : closure₀ M₀'.carrier = M₀'.carrier)
(hsep : has_seperate_points M₀'.carrier) :
closure₂ M₀'.carrier = univ :=
begin
  rw func_dense_iff_boundary_points_dense,
  intros x y hxy,
  cases subalgebra_of_R2 (subalgebra_of_boundary_points x y hc),
    { suffices : ((1, 1) : ℝ × ℝ) ∈ (subalgebra_of_boundary_points x y hc).carrier,
        exfalso, rw [h, mem_singleton_iff] at this,
        replace this := congr_arg prod.fst this, simp at this, assumption,
      exact one_mem_of_boundary_points hc },
  cases h,
    { suffices : ((1, 1) : ℝ × ℝ) ∈ (subalgebra_of_boundary_points x y hc).carrier,
        exfalso, rw h at this, cases this with r hr,
        simp at hr, assumption,
      exact one_mem_of_boundary_points hc },
  cases h,
    { suffices : ((1, 1) : ℝ × ℝ) ∈ (subalgebra_of_boundary_points x y hc).carrier,
        exfalso, rw h at this, cases this with r hr,
        simp at hr, assumption,
      exact one_mem_of_boundary_points hc },
  cases h,
    { rcases hsep x y hxy with ⟨f, hf₀, hf₁⟩,
      suffices : ((f x, f y) : ℝ × ℝ) ∈ (subalgebra_of_boundary_points x y hc).carrier,
        exfalso, rw h at this, cases this with r hr,
        apply hf₁, replace this : f x = r := congr_arg prod.fst hr,
        rw this, simp [show f y = r, by exact congr_arg prod.snd hr],
      refine ⟨f, _, rfl⟩, apply closure_le_seq₁, rwa hc },
    { exact h }
end


import data.real.basic
import data.real.sqrt

import analysis.inner_product_space.pi_L2
import analysis.normed_space.pi_Lp

open_locale big_operators

/-
Iranian Mathematical Olympiad 1998, Problem 9

Let x,y,z > 1 and 1/x + 1/y + 1/z = 2. Prove that

  √(x + y + z) ≥ √(x - 1) + √(y - 1) + √(z - 1).

-/

lemma compute_norm (v : euclidean_space ℝ (fin 3)) : ‖v‖ = real.sqrt (∑(i : fin 3), (v i)^2) :=
begin
  have hvi : (∀ i : fin 3, (v i) ^2 = ‖v i‖^2),
  { intro i, rw [real.norm_eq_abs], exact (sq_abs (v i)).symm },
  have := fintype.sum_congr ((λ jj, (v jj)^2): fin 3 → ℝ) (λ jj, ‖v jj‖^2) hvi,
  rw[this],
  exact euclidean_space.norm_eq v,
end

theorem iran1998_q9
  (x y z : ℝ)
  (hx : 1 < x)
  (hy : 1 < y)
  (hz : 1 < z)
  (h : 1/x + 1/y + 1/z = 2) :
  real.sqrt(x - 1) + real.sqrt(y - 1) + real.sqrt(z - 1) ≤ real.sqrt (x + y + z) :=
begin
  -- By cauchy schwarz,
  -- √(x + y + z) √((x-1)/x + (y-1)/y + (z-1)/z) ≥ √(x - 1) + √(y - 1) + √(z - 1).
  --
  -- On the other hand, by hypothesis,
  -- (x-1)/x + (y-1)/y + (z-1)/z = 1.
  --
  -- The desired result follows.

  have hxz : x ≠ 0 := by positivity,
  have hyz : y ≠ 0 := by positivity,
  have hzz : z ≠ 0 := by positivity,

  have hx0 : 0 ≤ x := by positivity,
  have hy0 : 0 ≤ y := by positivity,
  have hz0 : 0 ≤ z := by positivity,

  have hx1 : 0 ≤ x - 1 := by linarith,
  have hy1 : 0 ≤ y - 1 := by linarith,
  have hz1 : 0 ≤ z - 1 := by linarith,

  have hxf : (x-1)/x = 1 - 1/x := by field_simp,
  have hyf : (y-1)/y = 1 - 1/y := by field_simp,
  have hzf : (z-1)/z = 1 - 1/z := by field_simp,

  have h1 : (x-1)/x + (y-1)/y + (z-1)/z = 1,
  { rw[hxf, hyf, hzf],
    linarith },

  let v₁ : euclidean_space ℝ (fin 3) := ![real.sqrt x, real.sqrt y, real.sqrt z],
  let v₂ : euclidean_space ℝ (fin 3) :=
      ![real.sqrt ((x - 1)/x), real.sqrt ((y-1)/y), real.sqrt ((z-1)/z)],

  have cauchy_schwarz := @abs_inner_le_norm ℝ (euclidean_space ℝ (fin 3)) _ _ v₁ v₂,

  have hv₁ : ‖v₁‖ = real.sqrt (x + y + z),
  { have hn := compute_norm v₁,
    have h1: ((∑ (i : fin 3), ((v₁ i) ^ 2)) : ℝ) = (v₁ 0)^2 + (v₁ 1)^2 + (v₁ 2)^2,
    { rw[fin.sum_univ_succ, fin.sum_univ_succ, fin.sum_univ_one],
      ring },
    rw [h1] at hn,
    have hv1 : v₁ 0 = real.sqrt x := rfl,
    have hv2 : v₁ 1 = real.sqrt y := rfl,
    have hv3 : v₁ 2 = real.sqrt z := rfl,
    rw [hv1, hv2, hv3] at hn,
    have hxx : (real.sqrt x) ^ 2 = x := real.sq_sqrt hx0,
    have hyy : (real.sqrt y) ^ 2 = y := real.sq_sqrt hy0,
    have hzz : (real.sqrt z) ^ 2 = z := real.sq_sqrt hz0,

    rwa [hxx, hyy, hzz] at hn},

  have hv₂ : ‖v₂‖ = 1,
  { have hn := compute_norm v₂,
    have h2: ((∑ (i : fin 3), ((v₂ i) ^ 2)) : ℝ) = (v₂ 0)^2 + (v₂ 1)^2 + (v₂ 2)^2,
    { rw[fin.sum_univ_succ, fin.sum_univ_succ, fin.sum_univ_one],
      ring },
    rw [h2] at hn,
    have hv1 : v₂ 0 = real.sqrt ((x-1)/x) := rfl,
    have hv2 : v₂ 1 = real.sqrt ((y-1)/y) := rfl,
    have hv3 : v₂ 2 = real.sqrt ((z-1)/z) := rfl,
    rw [hv1, hv2, hv3] at hn,
    have hxx : 0 ≤ (x-1)/x := div_nonneg hx1 hx0,
    have hxx' : real.sqrt(((x - 1) / x)) ^2 = (x - 1) / x := real.sq_sqrt hxx,

    have hyy : 0 ≤ (y-1)/y := div_nonneg hy1 hy0,
    have hyy' : real.sqrt(((y - 1) / y)) ^2 = (y - 1) / y := real.sq_sqrt hyy,

    have hzz : 0 ≤ (z-1)/z := div_nonneg hz1 hz0,
    have hzz' : real.sqrt(((z - 1) / z)) ^2 = (z - 1) / z := real.sq_sqrt hzz,

    rw[hxx', hyy', hzz'] at hn,
    have hfs: (x - 1) / x + (y - 1) / y + (z - 1) / z = 3 - (1/x + 1/y + 1/z) := by {field_simp, ring},
    rw[hfs, h] at hn,
    have ha: (3: ℝ) - 2 = 1 := by norm_num,
    rw[hn, ha],
    exact real.sqrt_one},

  rw [hv₁, hv₂, mul_one] at cauchy_schwarz,

  have hinner := calc ((inner v₁ v₂): ℝ)
          = ∑(i : fin 3), v₁ i * v₂ i : rfl
      ... = v₁ 0 * v₂ 0 + v₁ 1 * v₂ 1 + v₁ 2 * v₂ 2 :
               by {rw[fin.sum_univ_succ, fin.sum_univ_succ, fin.sum_univ_one], ring}
      ... = real.sqrt x * real.sqrt ((x - 1) / x) +
            real.sqrt y * real.sqrt ((y - 1) / y) +
            real.sqrt z * real.sqrt ((z - 1) / z) : rfl,

  have hxxx : x * ((x - 1) / x) = x - 1 := by {field_simp, ring},
  have hyyy : y * ((y - 1) / y) = y - 1 := by {field_simp, ring},
  have hzzz : z * ((z - 1) / z) = z - 1 := by {field_simp, ring},

  rw [←real.sqrt_mul hx0 ((x - 1) / x),
      ←real.sqrt_mul hy0 ((y - 1) / y),
      ←real.sqrt_mul hz0 ((z - 1) / z),
      hxxx, hyyy, hzzz] at hinner,

  rw [hinner, is_R_or_C.abs_to_real] at cauchy_schwarz,
  exact le_of_abs_le cauchy_schwarz,
end