/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Chris Hughes

Adjoining roots of polynomials
-/

import data.polynomial ring_theory.principal_ideal_domain

universes u v w

variables {α : Type u} {β : Type v} {γ : Type w}

namespace adjoin_root
open polynomial ideal

section comm_ring
variables [comm_ring α] [decidable_eq α] (f : polynomial α)

def adjoin_root (f : polynomial α) : Type u :=
ideal.quotient (span {f} : ideal (polynomial α))

instance : comm_ring (adjoin_root f) := ideal.quotient.comm_ring _

noncomputable instance : decidable_eq (adjoin_root f) := classical.dec_eq _

variable {f}

def mk : polynomial α → adjoin_root f := ideal.quotient.mk _

def root : adjoin_root f := mk X

def of (x : α) : adjoin_root f := mk (C x)

instance adjoin_root.has_coe_t : has_coe_t α (adjoin_root f) := ⟨of⟩

instance mk.is_ring_hom : is_ring_hom (mk : polynomial α → adjoin_root f) :=
ideal.quotient.is_ring_hom_mk _

@[simp] lemma mk_self : (mk f : adjoin_root f) = 0 :=
quotient.sound' (mem_span_singleton.2 $ by simp)

instance : is_ring_hom (coe : α → adjoin_root f) :=
@is_ring_hom.comp _ _ _ _ C _ _ _ mk mk.is_ring_hom

lemma eval₂_root (f : polynomial α) : f.eval₂ coe (root : adjoin_root f) = 0 :=
quotient.induction_on' (root : adjoin_root f)
  (λ (g : polynomial α) (hg : mk g = mk X),
    show finsupp.sum f (λ (e : ℕ) (a : α), mk (C a) * mk g ^ e) = 0,
    by simp only [hg, (is_semiring_hom.map_pow (mk : polynomial α → adjoin_root f) _ _).symm,
         (is_ring_hom.map_mul (mk : polynomial α → adjoin_root f)).symm];
      rw [finsupp.sum, finset.sum_hom (mk : polynomial α → adjoin_root f),
        show finset.sum _ _ = _, from sum_C_mul_X_eq _, mk_self])
  (show (root : adjoin_root f) = mk X, from rfl)

lemma is_root_root (f : polynomial α) : is_root (f.map coe) (root : adjoin_root f) :=
by rw [is_root, eval_map, eval₂_root]

variables [comm_ring β]

def lift (i : α → β) [is_ring_hom i] (x : β) (h : f.eval₂ i x = 0) : (adjoin_root f) → β :=
ideal.quotient.lift _ (eval₂ i x) $ λ g H,
begin
  simp [mem_span_singleton] at H,
  cases H with y H,
  dsimp at H,
  rw [H, eval₂_mul],
  simp [h]
end

variables {i : α → β} [is_ring_hom i] {a : β} {h : f.eval₂ i a = 0}

@[simp] lemma lift_mk {g : polynomial α} : lift i a h (mk g) = g.eval₂ i a :=
ideal.quotient.lift_mk

@[simp] lemma lift_root : lift i a h root = a := by simp [root, h]

@[simp] lemma lift_of {x : α} : lift i a h x = i x :=
by show lift i a h (ideal.quotient.mk _ (C x)) = i x;
  convert ideal.quotient.lift_mk; simp

instance is_ring_hom_lift : is_ring_hom (lift i a h) :=
by unfold lift; apply_instance

end comm_ring

variables [discrete_field α] {f : polynomial α} [irreducible f]

instance is_maximal_span : is_maximal (span {f} : ideal (polynomial α)) :=
principal_ideal_domain.is_maximal_of_irreducible ‹irreducible f›

noncomputable instance field : discrete_field (adjoin_root f) :=
ideal.quotient.field (span {f} : ideal (polynomial α))

instance : is_field_hom (coe : α → adjoin_root f) := by apply_instance

instance lift_is_field_hom [field β] {i : α → β} [is_ring_hom i] {a : β}
  {h : f.eval₂ i a = 0} : is_field_hom (lift i a h) := by apply_instance

lemma coe_injective : function.injective (coe : α → adjoin_root f) :=
is_field_hom.injective _

lemma mul_div_root_cancel (f : polynomial α) [irreducible f] :
  (X - C (root : adjoin_root f)) * (f.map coe / (X - C root)) = f.map coe :=
mul_div_eq_iff_is_root.2 $ is_root_root _

end adjoin_root


import Mathlib

def sumTo (n: ℕ)  := match n with
  | 0 => 0
  | n + 1 => (n + 1) + sumTo n

theorem sum_formula (n: ℕ) : 2 * sumTo n = n * (n + 1):=
  by -- 2 * sumTo n = n * (n + 1)
  induction n with
  | zero => -- 2 * sumTo Nat.zero = Nat.zero * (Nat.zero + 1)
    rfl
  | succ n ih =>
    simp [sumTo] -- 2 * (n + 1 + sumTo n) = Nat.succ n * (Nat.succ n + 1)
    simp [left_distrib, ih]
    -- 2 * n + 2 + (n * n + n) = Nat.succ n * Nat.succ n + Nat.succ n
    linarith


import mynat.pow

-- *  Level 1
lemma zero_pow_zero : (0 : mynat) ^ (0 : mynat) = 1 :=

begin

rw pow_zero,
refl

end

-- * Level 2
lemma zero_pow_succ (m : mynat) : (0 : mynat) ^ (succ m) = 0 :=

begin

induction m,
rw pow_succ,
rw pow_zero,
rw mul_zero,
refl,
rw pow_succ,

end

-- * Level 3
lemma pow_one (a : mynat) : a ^ (1 : mynat) = a :=

begin

induction a,
rw one_eq_succ_zero,
rw pow_succ,
rw mul_zero,
refl,
rw one_eq_succ_zero,
rw pow_succ,

end

-- * Level 4

lemma one_pow (m : mynat) : (1 : mynat) ^ m = 1 :=

begin

induction m,
rw pow_zero,
refl,
rw pow_succ,
rw m_ih,
rw mul_one,
refl

end
-- * Level 5

lemma pow_add (a m n : mynat) : a ^ (m + n) = a ^ m * a ^ n :=

begin

induction n,
rw pow_zero,
rw mul_one,
rw add_zero,
refl,
rw pow_succ,
rw add_comm,
rw succ_add,
rw pow_succ,
rw add_comm,

end

-- * Level 6
lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n :=

begin

repeat {rw pow_succ },
rw n_ih,
simp,

end
-- * Level 7

lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n) :=

begin

induction n,
rw mul_zero,
repeat {rw pow_zero},
repeat {rw pow_succ},
rw mul_succ,
rw n_ih,
rw pow_add,
refl,

end

-- * Level 8
lemma add_squared (a b : mynat) :
  (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b :=

begin
rw two_eq_succ_one,
rw one_eq_succ_zero,
repeat {rw pow_succ},
repeat {rw pow_zero},
repeat {rw one_mul},
simp,
rw mul_succ,
rw <- one_eq_succ_zero,
rw mul_one,
repeat {rw add_mul},
repeat {rw mul_add},
simp,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Countable sets.
-/

import data.equiv.list data.set.finite logic.function data.set.function
noncomputable theory

open function set encodable

open classical (hiding some)
local attribute [instance] prop_decidable
universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

namespace set

/-- Countable sets

A set is countable if there exists an encoding of the set into the natural numbers.
An encoding is an injection with a partial inverse, which can be viewed as a
constructive analogue of countability. (For the most part, theorems about
`countable` will be classical and `encodable` will be constructive.)
-/
def countable (s : set α) : Prop := nonempty (encodable s)

lemma countable_iff_exists_injective {s : set α} :
  countable s ↔ ∃f:s → ℕ, injective f :=
⟨λ ⟨h⟩, by exactI ⟨encode, encode_injective⟩,
 λ ⟨f, h⟩, ⟨⟨f, partial_inv f, partial_inv_left h⟩⟩⟩

lemma countable_iff_exists_inj_on {s : set α} :
  countable s ↔ ∃ f : α → ℕ, inj_on f s :=
countable_iff_exists_injective.trans
⟨λ ⟨f, hf⟩, ⟨λ a, if h : a ∈ s then f ⟨a, h⟩ else 0,
   λ a b as bs h, congr_arg subtype.val $
     hf $ by simpa [as, bs] using h⟩,
 λ ⟨f, hf⟩, ⟨_, inj_on_iff_injective.1 hf⟩⟩

lemma countable_iff_exists_surjective [ne : inhabited α] {s : set α} :
  countable s ↔ ∃f:ℕ → α, s ⊆ range f :=
⟨λ ⟨h⟩, by exactI ⟨λ n, ((decode s n).map subtype.val).iget,
  λ a as, ⟨encode (⟨a, as⟩ : s), by simp [encodek]⟩⟩,
 λ ⟨f, hf⟩, ⟨⟨
  λ x, inv_fun f x.1,
  λ n, if h : f n ∈ s then some ⟨f n, h⟩ else none,
  λ ⟨x, hx⟩, begin
    have := inv_fun_eq (hf hx), dsimp at this ⊢,
    simp [this, hx]
  end⟩⟩⟩

def countable.to_encodable {s : set α} : countable s → encodable s :=
classical.choice

lemma countable_encodable' (s : set α) [H : encodable s] : countable s :=
⟨H⟩

lemma countable_encodable [encodable α] (s : set α) : countable s :=
⟨by apply_instance⟩

@[simp] lemma countable_empty : countable (∅ : set α) :=
⟨⟨λ x, x.2.elim, λ n, none, λ x, x.2.elim⟩⟩

@[simp] lemma countable_singleton (a : α) : countable ({a} : set α) :=
⟨of_equiv _ (equiv.set.singleton a)⟩

lemma countable_subset {s₁ s₂ : set α} (h : s₁ ⊆ s₂) : countable s₂ → countable s₁
| ⟨H⟩ := ⟨@of_inj _ _ H _ (embedding_of_subset h).2⟩

lemma countable_image {s : set α} (f : α → β) (hs : countable s) : countable (f '' s) :=
let f' : s → f '' s := λ⟨a, ha⟩, ⟨f a, mem_image_of_mem f ha⟩ in
have hf' : surjective f', from assume ⟨b, a, ha, hab⟩, ⟨⟨a, ha⟩, subtype.eq hab⟩,
⟨@encodable.of_inj _ _ hs.to_encodable (surj_inv hf') (injective_surj_inv hf')⟩

lemma countable_range [encodable α] (f : α → β) : countable (range f) :=
by rw ← image_univ; exact countable_image _ (countable_encodable _)

lemma countable_Union {t : α → set β} [encodable α] (ht : ∀a, countable (t a)) :
  countable (⋃a, t a) :=
by haveI := (λ a, (ht a).to_encodable);
   rw Union_eq_range_sigma; apply countable_range

lemma countable_bUnion {s : set α} {t : α → set β} (hs : countable s) (ht : ∀a∈s, countable (t a)) :
  countable (⋃a∈s, t a) :=
begin
  rw bUnion_eq_Union,
  haveI := hs.to_encodable,
  exact countable_Union (by simpa using ht)
end

lemma countable_sUnion {s : set (set α)} (hs : countable s) (h : ∀a∈s, countable a) :
  countable (⋃₀ s) :=
by rw sUnion_eq_bUnion; exact countable_bUnion hs h

lemma countable_Union_Prop {p : Prop} {t : p → set β} (ht : ∀h:p, countable (t h)) :
  countable (⋃h:p, t h) :=
by by_cases p; simp [h, ht]

lemma countable_union {s₁ s₂ : set α} (h₁ : countable s₁) (h₂ : countable s₂) : countable (s₁ ∪ s₂) :=
by rw union_eq_Union; exact
countable_Union (bool.forall_bool.2 ⟨h₂, h₁⟩)

lemma countable_insert {s : set α} {a : α} (h : countable s) : countable (insert a s) :=
by rw [set.insert_eq]; from countable_union (countable_singleton _) h

lemma countable_finite {s : set α} : finite s → countable s
| ⟨h⟩ := nonempty_of_trunc (by exactI trunc_encodable_of_fintype s)

lemma countable_set_of_finite_subset {s : set α} : countable s →
  countable {t | finite t ∧ t ⊆ s} | ⟨h⟩ :=
begin
  resetI,
  refine countable_subset _ (countable_range
    (λ t : finset s, {a | ∃ h:a ∈ s, subtype.mk a h ∈ t})),
  rintro t ⟨⟨ht⟩, ts⟩,
  refine ⟨finset.univ.map (embedding_of_subset ts),
    set.ext $ λ a, _⟩,
  simp, split,
  { rintro ⟨as, b, bt, e⟩,
    cases congr_arg subtype.val e, exact bt },
  { exact λ h, ⟨ts h, _, h, rfl⟩ }
end

lemma countable_pi {π : α → Type*} [fintype α] {s : Πa, set (π a)} (hs : ∀a, countable (s a)) :
  countable {f : Πa, π a | ∀a, f a ∈ s a} :=
countable_subset
  (show {f : Πa, π a | ∀a, f a ∈ s a} ⊆ range (λf : Πa, s a, λa, (f a).1), from
    assume f hf, ⟨λa, ⟨f a, hf a⟩, funext $ assume a, rfl⟩) $
have trunc (encodable (Π (a : α), s a)), from
  @encodable.fintype_pi α _ _ _ (assume a, (hs a).to_encodable),
trunc.induction_on this $ assume h,
@countable_range _ _ h _

end set


-- Las_funciones_con_inversa_son_biyectivas.lean
-- Las funciones con inversa son biyectivas
-- José A. Alonso Jiménez
-- Sevilla, 8 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean se puede definir que g es una inversa de f por
--    def inversa (f : X → Y) (g : Y → X) :=
--      (∀ x, (g ∘ f) x = x) ∧ (∀ y, (f ∘ g) y = y)
-- y que f tiene inversa por
--    def tiene_inversa (f : X → Y) :=
--      ∃ g, inversa g f
--
-- Demostrar que si la función f tiene inversa, entonces f es biyectiva.
-- ---------------------------------------------------------------------

import tactic
open function

variables {X Y : Type*}
variable  (f : X → Y)

def inversa (f : X → Y) (g : Y → X) :=
  (∀ x, (g ∘ f) x = x) ∧ (∀ y, (f ∘ g) y = y)

def tiene_inversa (f : X → Y) :=
  ∃ g, inversa g f

-- 1ª demostración
example
  (hf : tiene_inversa f)
  : bijective f :=
begin
  rcases hf with ⟨g, ⟨h1, h2⟩⟩,
  split,
  { intros a b hab,
    calc a = g (f a) : (h2 a).symm
       ... = g (f b) : congr_arg g hab
       ... = b       : h2 b, },
  { intro y,
    use g y,
    exact h1 y, },
end

-- 2ª demostración
example
  (hf : tiene_inversa f)
  : bijective f :=
begin
  rcases hf with ⟨g, ⟨h1, h2⟩⟩,
  split,
  { intros a b hab,
    calc a = g (f a) : (h2 a).symm
       ... = g (f b) : congr_arg g hab
       ... = b       : h2 b, },
  { intro y,
    use [g y, h1 y], },
end

-- 3ª demostración
example
  (hf : tiene_inversa f)
  : bijective f :=
begin
  rcases hf with ⟨g, ⟨h1, h2⟩⟩,
  split,
  { exact left_inverse.injective h2, },
  { exact right_inverse.surjective h1, },
end

-- 4ª demostración
example
  (hf : tiene_inversa f)
  : bijective f :=
begin
  rcases hf with ⟨g, ⟨h1, h2⟩⟩,
  exact ⟨left_inverse.injective h2,
         right_inverse.surjective h1⟩,
end

-- 5ª demostración
example :
  tiene_inversa f → bijective f :=
begin
  rintros ⟨g, ⟨h1, h2⟩⟩,
  exact ⟨left_inverse.injective h2,
         right_inverse.surjective h1⟩,
end

-- 6ª demostración
example :
  tiene_inversa f → bijective f :=
λ ⟨g, ⟨h1, h2⟩⟩, ⟨left_inverse.injective h2,
                  right_inverse.surjective h1⟩


/- LoVe Homework 1: Definitions and Lemma Statements -/

/- Replace the placeholders (e.g., `:= sorry`) with your solutions. -/

import .lovelib

namespace LoVe

/- Question 1: Snoc -/

/- 1.1. Define the function `snoc` that appends a single element to the end of
a list. -/

def snoc {α : Type} : list α → α → list α
:= sorry

/- 1.2. Convince yourself that your definition of `snoc` works by testing it on
a few examples. -/

-- invoke `#reduce` or `#eval` here

/- Question 2: Map -/

/- 2.1. Define a generic `map` function that applies a function to every element
in a list. -/

def map {α : Type} {β : Type} (f : α → β) : list α → list β
:= sorry

/- 2.2. State the so-called functiorial properties of `map` as lemmas.
Schematically:

     map (λx, x) xs = xs
     map (λx, g (f x)) xs = map g (map f xs)

Make sure to state the second law as generally as possible, for arbitrary
types. -/

-- enter your lemma statements here

/- Question 3: λ-Terms -/

/- We start by declaring four new opaque types. -/

constants α β γ δ : Type

/- 3.1. Complete the following definitions, by providing terms with the expected
type. -/

def B : (α → β) → (γ → α) → γ → β :=
sorry

def S : (α → β → γ) → (α → β) → α → γ :=
sorry

def more_nonsense : ((α → β) → γ → δ) → γ → β → δ :=
sorry

def even_more_nonsense : (α → β) → (α → γ) → α → β → γ :=
sorry

/- 3.2 (**optional**). Complete the following definition.

Note: Peirce is pronounced like the English word "purse". -/

def weak_peirce : ((((α → β) → α) → α) → β) → β :=
sorry

end LoVe


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import ring_theory.finiteness
import linear_algebra.dimension

/-!
# A module over a division ring is noetherian if and only if it is finite.

-/

universes u v

open_locale classical cardinal
open cardinal submodule module function

namespace is_noetherian

variables {K : Type u} {V : Type v} [division_ring K] [add_comm_group V] [module K V]

-- PROJECT: Show all division rings are noetherian.
-- This is currently annoying because we only have ideal of commutative rings.
variables [is_noetherian_ring K]

/--
A module over a division ring is noetherian if and only if
its dimension (as a cardinal) is strictly less than the first infinite cardinal `ω`.
-/
lemma iff_dim_lt_omega : is_noetherian K V ↔ module.rank K V < ω :=
begin
  let b := basis.of_vector_space K V,
  rw [← b.mk_eq_dim'', lt_omega_iff_finite],
  split,
  { introI,
    exact finite_of_linear_independent (basis.of_vector_space_index.linear_independent K V) },
  { assume hbfinite,
    refine @is_noetherian_of_linear_equiv K (⊤ : submodule K V) V _
      _ _ _ _ (linear_equiv.of_top _ rfl) (id _),
    refine is_noetherian_of_fg_of_noetherian _ ⟨set.finite.to_finset hbfinite, _⟩,
    rw [set.finite.coe_to_finset, ← b.span_eq, basis.coe_of_vector_space, subtype.range_coe] }
end

variables (K V)

/-- The dimension of a noetherian module over a division ring, as a cardinal,
is strictly less than the first infinite cardinal `ω`. -/
lemma dim_lt_omega : ∀ [is_noetherian K V], module.rank K V < ω :=
is_noetherian.iff_dim_lt_omega.1

variables {K V}

/-- In a noetherian module over a division ring, all bases are indexed by a finite type. -/
noncomputable def fintype_basis_index {ι : Type*} [is_noetherian K V] (b : basis ι K V) :
  fintype ι :=
b.fintype_index_of_dim_lt_omega (dim_lt_omega K V)

/-- In a noetherian module over a division ring,
`basis.of_vector_space` is indexed by a finite type. -/
noncomputable instance [is_noetherian K V] : fintype (basis.of_vector_space_index K V) :=
fintype_basis_index (basis.of_vector_space K V)

/-- In a noetherian module over a division ring,
if a basis is indexed by a set, that set is finite. -/
lemma finite_basis_index {ι : Type*} {s : set ι} [is_noetherian K V] (b : basis s K V) :
  s.finite :=
b.finite_index_of_dim_lt_omega (dim_lt_omega K V)

variables (K V)

/-- In a noetherian module over a division ring,
there exists a finite basis. This is the indexing `finset`. -/
noncomputable def finset_basis_index [is_noetherian K V] :
  finset V :=
(finite_basis_index (basis.of_vector_space K V)).to_finset

@[simp] lemma coe_finset_basis_index [is_noetherian K V] :
  (↑(finset_basis_index K V) : set V) = basis.of_vector_space_index K V :=
set.finite.coe_to_finset _

@[simp] lemma coe_sort_finset_basis_index [is_noetherian K V] :
  ((finset_basis_index K V) : Type*) = basis.of_vector_space_index K V :=
set.finite.coe_sort_to_finset _

/--
In a noetherian module over a division ring, there exists a finite basis.
This is indexed by the `finset` `finite_dimensional.finset_basis_index`.
This is in contrast to the result `finite_basis_index (basis.of_vector_space K V)`,
which provides a set and a `set.finite`.
-/
noncomputable def finset_basis [is_noetherian K V] :
  basis (finset_basis_index K V) K V :=
(basis.of_vector_space K V).reindex (by simp)

@[simp] lemma range_finset_basis [is_noetherian K V] :
  set.range (finset_basis K V) = basis.of_vector_space_index K V :=
by rw [finset_basis, basis.range_reindex, basis.range_of_vector_space]

variables {K V}

/-- A module over a division ring is noetherian if and only if it is finitely generated. -/
lemma iff_fg :
  is_noetherian K V ↔ module.finite K V :=
begin
  split,
  { introI h,
    exact ⟨⟨finset_basis_index K V, by { convert (finset_basis K V).span_eq, simp }⟩⟩ },
  { rintros ⟨s, hs⟩,
    rw [is_noetherian.iff_dim_lt_omega, ← dim_top, ← hs],
    exact lt_of_le_of_lt (dim_span_le _) (lt_omega_iff_finite.2 (set.finite_mem_finset s)) }
end

end is_noetherian


/-
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
-/
import data.list.big_operators

/-!
# Counting in lists

This file proves basic properties of `list.countp` and `list.count`, which count the number of
elements of a list satisfying a predicate and equal to a given element respectively. Their
definitions can be found in [`data.list.defs`](./data/list/defs).
-/

open nat

variables {α β : Type*} {l l₁ l₂ : list α}

namespace list

section countp
variables (p : α → Prop) [decidable_pred p]

@[simp] lemma countp_nil : countp p [] = 0 := rfl

@[simp] lemma countp_cons_of_pos {a : α} (l) (pa : p a) : countp p (a::l) = countp p l + 1 :=
if_pos pa

@[simp] lemma countp_cons_of_neg {a : α} (l) (pa : ¬ p a) : countp p (a::l) = countp p l :=
if_neg pa

lemma length_eq_countp_add_countp (l) : length l = countp p l + countp (λ a, ¬p a) l :=
by induction l with x h ih; [refl, by_cases p x];
  [simp only [countp_cons_of_pos _ _ h, countp_cons_of_neg (λ a, ¬p a) _ (decidable.not_not.2 h),
    ih, length],
   simp only [countp_cons_of_pos (λ a, ¬p a) _ h, countp_cons_of_neg _ _ h, ih, length]]; ac_refl

lemma countp_eq_length_filter (l) : countp p l = length (filter p l) :=
by induction l with x l ih; [refl, by_cases (p x)];
  [simp only [filter_cons_of_pos _ h, countp, ih, if_pos h],
   simp only [countp_cons_of_neg _ _ h, ih, filter_cons_of_neg _ h]]; refl

lemma countp_le_length : countp p l ≤ l.length :=
by simpa only [countp_eq_length_filter] using length_le_of_sublist (filter_sublist _)

@[simp] lemma countp_append (l₁ l₂) : countp p (l₁ ++ l₂) = countp p l₁ + countp p l₂ :=
by simp only [countp_eq_length_filter, filter_append, length_append]

lemma countp_pos {l} : 0 < countp p l ↔ ∃ a ∈ l, p a :=
by simp only [countp_eq_length_filter, length_pos_iff_exists_mem, mem_filter, exists_prop]

lemma length_filter_lt_length_iff_exists (l) : length (filter p l) < length l ↔ ∃ x ∈ l, ¬p x :=
by rw [length_eq_countp_add_countp p l, ← countp_pos, countp_eq_length_filter, lt_add_iff_pos_right]

lemma sublist.countp_le (s : l₁ <+ l₂) : countp p l₁ ≤ countp p l₂ :=
by simpa only [countp_eq_length_filter] using length_le_of_sublist (s.filter p)

@[simp] lemma countp_filter {q} [decidable_pred q] (l : list α) :
  countp p (filter q l) = countp (λ a, p a ∧ q a) l :=
by simp only [countp_eq_length_filter, filter_filter]

@[simp] lemma countp_true : l.countp (λ _, true) = l.length :=
by simp [countp_eq_length_filter]

@[simp] lemma countp_false : l.countp (λ _, false) = 0 :=
by simp [countp_eq_length_filter]

end countp

/-! ### count -/

section count
variables [decidable_eq α]

@[simp] lemma count_nil (a : α) : count a [] = 0 := rfl

lemma count_cons (a b : α) (l : list α) :
  count a (b :: l) = if a = b then succ (count a l) else count a l := rfl

lemma count_cons' (a b : α) (l : list α) :
  count a (b :: l) = count a l + (if a = b then 1 else 0) :=
begin rw count_cons, split_ifs; refl end

@[simp] lemma count_cons_self (a : α) (l : list α) : count a (a::l) = succ (count a l) := if_pos rfl

@[simp, priority 990]
lemma count_cons_of_ne {a b : α} (h : a ≠ b) (l : list α) : count a (b::l) = count a l := if_neg h

lemma count_tail : Π (l : list α) (a : α) (h : 0 < l.length),
  l.tail.count a = l.count a - ite (a = list.nth_le l 0 h) 1 0
| (_ :: _) a h := by { rw [count_cons], split_ifs; simp }

lemma count_le_length (a : α) (l : list α) : count a l ≤ l.length :=
countp_le_length _

lemma sublist.count_le (h : l₁ <+ l₂) (a : α) : count a l₁ ≤ count a l₂ := h.countp_le _

lemma count_le_count_cons (a b : α) (l : list α) : count a l ≤ count a (b :: l) :=
(sublist_cons _ _).count_le _

lemma count_singleton (a : α) : count a [a] = 1 := if_pos rfl

lemma count_singleton' (a b : α) : count a [b] = ite (a = b) 1 0 := rfl

@[simp] lemma count_append (a : α) : ∀ l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ :=
countp_append _

lemma count_concat (a : α) (l : list α) : count a (concat l a) = succ (count a l) :=
by simp [-add_comm]

@[simp] lemma count_pos {a : α} {l : list α} : 0 < count a l ↔ a ∈ l :=
by simp only [count, countp_pos, exists_prop, exists_eq_right']

@[simp] lemma one_le_count_iff_mem {a : α} {l : list α} : 1 ≤ count a l ↔ a ∈ l :=
count_pos

@[simp, priority 980]
lemma count_eq_zero_of_not_mem {a : α} {l : list α} (h : a ∉ l) : count a l = 0 :=
decidable.by_contradiction $ λ h', h $ count_pos.1 (nat.pos_of_ne_zero h')

lemma not_mem_of_count_eq_zero {a : α} {l : list α} (h : count a l = 0) : a ∉ l :=
λ h', (count_pos.2 h').ne' h

@[simp] lemma count_repeat (a : α) (n : ℕ) : count a (repeat a n) = n :=
by rw [count, countp_eq_length_filter, filter_eq_self.2, length_repeat];
   exact λ b m, (eq_of_mem_repeat m).symm

lemma le_count_iff_repeat_sublist {a : α} {l : list α} {n : ℕ} :
  n ≤ count a l ↔ repeat a n <+ l :=
⟨λ h, ((repeat_sublist_repeat a).2 h).trans $
  have filter (eq a) l = repeat a (count a l), from eq_repeat.2
    ⟨by simp only [count, countp_eq_length_filter], λ b m, (of_mem_filter m).symm⟩,
  by rw ← this; apply filter_sublist,
 λ h, by simpa only [count_repeat] using h.count_le a⟩

lemma repeat_count_eq_of_count_eq_length  {a : α} {l : list α} (h : count a l = length l)  :
  repeat a (count a l) = l :=
eq_of_sublist_of_length_eq (le_count_iff_repeat_sublist.mp (le_refl (count a l)))
    (eq.trans (length_repeat a (count a l)) h)

@[simp] lemma count_filter {p} [decidable_pred p]
  {a} {l : list α} (h : p a) : count a (filter p l) = count a l :=
by simp only [count, countp_filter, show (λ b, a = b ∧ p b) = eq a, by { ext b, constructor; cc }]

lemma count_bind {α β} [decidable_eq β] (l : list α) (f : α → list β) (x : β)  :
  count x (l.bind f) = sum (map (count x ∘ f) l) :=
begin
  induction l with hd tl IH,
  { simp },
  { simpa }
end

@[simp] lemma count_map_of_injective {α β} [decidable_eq α] [decidable_eq β]
  (l : list α) (f : α → β) (hf : function.injective f) (x : α) :
  count (f x) (map f l) = count x l :=
begin
  induction l with y l IH generalizing x,
  { simp },
  { rw map_cons,
    by_cases h : x = y,
    { simpa [h] using IH _ },
    { simpa [h, hf.ne h] using IH _ } }
end

lemma count_le_count_map [decidable_eq β] (l : list α) (f : α → β) (x : α) :
  count x l ≤ count (f x) (map f l) :=
begin
  induction l with a as IH, { simp },
  rcases eq_or_ne x a with rfl | hxa,
  { simp [succ_le_succ IH] },
  { simp [hxa, le_add_right IH, count_cons'] }
end

@[simp] lemma count_erase_self (a : α) :
  ∀ (s : list α), count a (list.erase s a) = pred (count a s)
| [] := by simp
| (h :: t) :=
begin
  rw erase_cons,
  by_cases p : h = a,
  { rw [if_pos p, count_cons', if_pos p.symm], simp },
  { rw [if_neg p, count_cons', count_cons', if_neg (λ x : a = h, p x.symm), count_erase_self],
    simp }
end

@[simp] lemma count_erase_of_ne {a b : α} (ab : a ≠ b) :
  ∀ (s : list α), count a (list.erase s b) = count a s
| [] := by simp
| (x :: xs) :=
begin
  rw erase_cons,
  split_ifs with h,
  { rw [count_cons', h, if_neg ab], simp },
  { rw [count_cons', count_cons', count_erase_of_ne] }
end

end count

end list


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll
-/
import analysis.locally_convex.basic
import order.closure

/-!
# Balanced Core and Balanced Hull

## Main definitions

* `balanced_core`: The largest balanced subset of a set `s`.
* `balanced_hull`: The smallest balanced superset of a set `s`.

## Main statements

* `balanced_core_eq_Inter`: Characterization of the balanced core as an intersection over subsets.
* `nhds_basis_closed_balanced`: The closed balanced sets form a basis of the neighborhood filter.

## Implementation details

The balanced core and hull are implemented differently: for the core we take the obvious definition
of the union over all balanced sets that are contained in `s`, whereas for the hull, we take the
union over `r • s`, for `r` the scalars with `∥r∥ ≤ 1`. We show that `balanced_hull` has the
defining properties of a hull in `balanced.hull_minimal` and `subset_balanced_hull`.
For the core we need slightly stronger assumptions to obtain a characterization as an intersection,
this is `balanced_core_eq_Inter`.

## References

* [Bourbaki, *Topological Vector Spaces*][bourbaki1987]

## Tags

balanced
-/

open set
open_locale pointwise topological_space filter

variables {𝕜 E ι : Type*}

section balanced_hull

section semi_normed_ring
variables [semi_normed_ring 𝕜]

section has_scalar
variables [has_scalar 𝕜 E]

variables (𝕜)

/-- The largest balanced subset of `s`.-/
def balanced_core (s : set E) := ⋃₀ {t : set E | balanced 𝕜 t ∧ t ⊆ s}

/-- Helper definition to prove `balanced_core_eq_Inter`-/
def balanced_core_aux (s : set E) := ⋂ (r : 𝕜) (hr : 1 ≤ ∥r∥), r • s

/-- The smallest balanced superset of `s`.-/
def balanced_hull (s : set E) := ⋃ (r : 𝕜) (hr : ∥r∥ ≤ 1), r • s

variables {𝕜}

lemma balanced_core_subset (s : set E) : balanced_core 𝕜 s ⊆ s :=
begin
  refine sUnion_subset (λ t ht, _),
  simp only [mem_set_of_eq] at ht,
  exact ht.2,
end

lemma balanced_core_emptyset : balanced_core 𝕜 (∅ : set E) = ∅ :=
set.eq_empty_of_subset_empty (balanced_core_subset _)

lemma balanced_core_mem_iff {s : set E} {x : E} : x ∈ balanced_core 𝕜 s ↔
  ∃ t : set E, balanced 𝕜 t ∧ t ⊆ s ∧ x ∈ t :=
by simp_rw [balanced_core, mem_sUnion, mem_set_of_eq, exists_prop, and_assoc]

lemma smul_balanced_core_subset (s : set E) {a : 𝕜} (ha : ∥a∥ ≤ 1) :
  a • balanced_core 𝕜 s ⊆ balanced_core 𝕜 s :=
begin
  rw subset_def,
  intros x hx,
  rw mem_smul_set at hx,
  rcases hx with ⟨y, hy, hx⟩,
  rw balanced_core_mem_iff at hy,
  rcases hy with ⟨t, ht1, ht2, hy⟩,
  rw ←hx,
  refine ⟨t, _, ht1 a ha (smul_mem_smul_set hy)⟩,
  rw mem_set_of_eq,
  exact ⟨ht1, ht2⟩,
end

lemma balanced_core_balanced (s : set E) : balanced 𝕜 (balanced_core 𝕜 s) :=
λ _, smul_balanced_core_subset s

/-- The balanced core of `t` is maximal in the sense that it contains any balanced subset
`s` of `t`.-/
lemma balanced.subset_core_of_subset {s t : set E} (hs : balanced 𝕜 s) (h : s ⊆ t):
  s ⊆ balanced_core 𝕜 t :=
begin
  refine subset_sUnion_of_mem _,
  rw [mem_set_of_eq],
  exact ⟨hs, h⟩,
end

lemma balanced_core_aux_mem_iff (s : set E) (x : E) : x ∈ balanced_core_aux 𝕜 s ↔
  ∀ (r : 𝕜) (hr : 1 ≤ ∥r∥), x ∈ r • s :=
by rw [balanced_core_aux, set.mem_Inter₂]

lemma balanced_hull_mem_iff (s : set E) (x : E) : x ∈ balanced_hull 𝕜 s ↔
  ∃ (r : 𝕜) (hr : ∥r∥ ≤ 1), x ∈ r • s :=
by rw [balanced_hull, set.mem_Union₂]

/-- The balanced core of `s` is minimal in the sense that it is contained in any balanced superset
`t` of `s`. -/
lemma balanced.hull_subset_of_subset {s t : set E} (ht : balanced 𝕜 t) (h : s ⊆ t) :
  balanced_hull 𝕜 s ⊆ t :=
begin
  intros x hx,
  rcases (balanced_hull_mem_iff _ _).mp hx with ⟨r, hr, hx⟩,
  rcases mem_smul_set.mp hx with ⟨y, hy, hx⟩,
  rw ←hx,
  exact balanced_mem ht (h hy) hr,
end

end has_scalar

section add_comm_monoid

variables [add_comm_monoid E] [module 𝕜 E]

lemma balanced_core_nonempty_iff {s : set E} : (balanced_core 𝕜 s).nonempty ↔ (0 : E) ∈ s :=
begin
  split; intro h,
  { cases h with x hx,
    have h' : balanced 𝕜 (balanced_core 𝕜 s) := balanced_core_balanced s,
    have h'' := h' 0 (has_le.le.trans norm_zero.le zero_le_one),
    refine mem_of_subset_of_mem (subset.trans h'' (balanced_core_subset s)) _,
    exact mem_smul_set.mpr ⟨x, hx, zero_smul _ _⟩ },
  refine nonempty_of_mem (mem_of_subset_of_mem _ (mem_singleton 0)),
  exact balanced.subset_core_of_subset zero_singleton_balanced (singleton_subset_iff.mpr h),
end

lemma balanced_core_zero_mem {s : set E} (hs: (0 : E) ∈ s) : (0 : E) ∈ balanced_core 𝕜 s :=
balanced_core_mem_iff.mpr
  ⟨{0}, zero_singleton_balanced, singleton_subset_iff.mpr hs, mem_singleton 0⟩

variables (𝕜)

lemma subset_balanced_hull [norm_one_class 𝕜] {s : set E} : s ⊆ balanced_hull 𝕜 s :=
λ _ hx, (balanced_hull_mem_iff _ _).mpr ⟨1, norm_one.le, mem_smul_set.mp ⟨_, hx, one_smul _ _⟩⟩

variables {𝕜}

lemma balanced_hull.balanced (s : set E) : balanced 𝕜 (balanced_hull 𝕜 s) :=
begin
  intros a ha,
  simp_rw [balanced_hull, smul_set_Union₂, subset_def, mem_Union₂],
  intros x hx,
  rcases hx with ⟨r, hr, hx⟩,
  use [a • r],
  split,
  { rw smul_eq_mul,
    refine has_le.le.trans (semi_normed_ring.norm_mul _ _) _,
    refine mul_le_one ha (norm_nonneg r) hr },
  rw smul_assoc,
  exact hx,
end

end add_comm_monoid

end semi_normed_ring

section normed_field

variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E]

@[simp] lemma balanced_core_aux_empty : balanced_core_aux 𝕜 (∅ : set E) = ∅ :=
begin
  rw [balanced_core_aux, set.Inter₂_eq_empty_iff],
  intros _,
  simp only [smul_set_empty, mem_empty_eq, not_false_iff, exists_prop, and_true],
  exact ⟨1, norm_one.ge⟩,
end

lemma balanced_core_aux_subset (s : set E) : balanced_core_aux 𝕜 s ⊆ s :=
begin
  rw subset_def,
  intros x hx,
  rw balanced_core_aux_mem_iff at hx,
  have h := hx 1 norm_one.ge,
  rw one_smul at h,
  exact h,
end

lemma balanced_core_aux_balanced {s : set E} (h0 : (0 : E) ∈ balanced_core_aux 𝕜 s):
  balanced 𝕜 (balanced_core_aux 𝕜 s) :=
begin
  intros a ha x hx,
  rcases mem_smul_set.mp hx with ⟨y, hy, hx⟩,
  by_cases (a = 0),
  { simp[h] at hx,
    rw ←hx,
    exact h0 },
  rw [←hx, balanced_core_aux_mem_iff],
  rw balanced_core_aux_mem_iff at hy,
  intros r hr,
  have h'' : 1 ≤ ∥a⁻¹ • r∥ :=
  begin
    rw smul_eq_mul,
    simp only [norm_mul, norm_inv],
    exact one_le_mul_of_one_le_of_one_le (one_le_inv (norm_pos_iff.mpr h) ha) hr,
  end,
  have h' := hy (a⁻¹ • r) h'',
  rw smul_assoc at h',
  exact (mem_inv_smul_set_iff₀ h _ _).mp h',
end

lemma balanced_core_aux_maximal {s t : set E} (h : t ⊆ s) (ht : balanced 𝕜 t) :
  t ⊆ balanced_core_aux 𝕜 s :=
begin
  intros x hx,
  rw balanced_core_aux_mem_iff,
  intros r hr,
  rw mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp (lt_of_lt_of_le zero_lt_one hr)),
  refine h (balanced_mem ht hx _),
  rw norm_inv,
  exact inv_le_one hr,
end

lemma balanced_core_subset_balanced_core_aux {s : set E} :
  balanced_core 𝕜 s ⊆ balanced_core_aux 𝕜 s :=
balanced_core_aux_maximal (balanced_core_subset s) (balanced_core_balanced s)

lemma balanced_core_eq_Inter {s : set E} (hs : (0 : E) ∈ s) :
  balanced_core 𝕜 s = ⋂ (r : 𝕜) (hr : 1 ≤ ∥r∥), r • s :=
begin
  rw ←balanced_core_aux,
  refine subset_antisymm balanced_core_subset_balanced_core_aux _,
  refine balanced.subset_core_of_subset (balanced_core_aux_balanced _) (balanced_core_aux_subset s),
  refine mem_of_subset_of_mem balanced_core_subset_balanced_core_aux (balanced_core_zero_mem hs),
end

lemma subset_balanced_core {U V : set E} (hV' : (0 : E) ∈ V)
  (hUV : ∀ (a : 𝕜) (ha : ∥a∥ ≤ 1), a • U ⊆ V) :
  U ⊆ balanced_core 𝕜 V :=
begin
  rw balanced_core_eq_Inter hV',
  refine set.subset_Inter₂ (λ a ha, _),
  rw [←one_smul 𝕜 U, ←mul_inv_cancel (norm_pos_iff.mp (lt_of_lt_of_le zero_lt_one ha)),
    ←smul_eq_mul, smul_assoc],
  refine set.smul_set_mono (hUV a⁻¹ _),
  rw [norm_inv],
  exact inv_le_one ha,
end

end normed_field

end balanced_hull

/-! ### Topological properties -/

section topology

variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E]
  [has_continuous_smul 𝕜 E]

lemma balanced_core_is_closed {U : set E} (hU : is_closed U) : is_closed (balanced_core 𝕜 U) :=
begin
  by_cases h : (0 : E) ∈ U,
  { rw balanced_core_eq_Inter h,
    refine is_closed_Inter (λ a, _),
    refine is_closed_Inter (λ ha, _),
    have ha' := lt_of_lt_of_le zero_lt_one ha,
    rw norm_pos_iff at ha',
    refine is_closed_map_smul_of_ne_zero ha' U hU },
  convert is_closed_empty,
  contrapose! h,
  exact balanced_core_nonempty_iff.mp (set.ne_empty_iff_nonempty.mp h),
end

lemma balanced_core_mem_nhds_zero {U : set E} (hU : U ∈ 𝓝 (0 : E)) :
  balanced_core 𝕜 U ∈ 𝓝 (0 : E) :=
begin
  -- Getting neighborhoods of the origin for `0 : 𝕜` and `0 : E`
  have h : filter.tendsto (λ (x : 𝕜 × E), x.fst • x.snd) (𝓝 (0,0)) (𝓝 ((0 : 𝕜) • (0 : E))) :=
  continuous_iff_continuous_at.mp has_continuous_smul.continuous_smul (0, 0),
  rw [smul_zero] at h,
  have h' := filter.has_basis.prod (@metric.nhds_basis_ball 𝕜 _ 0) (filter.basis_sets (𝓝 (0 : E))),
  simp_rw [←nhds_prod_eq, id.def] at h',
  have h'' := filter.tendsto.basis_left h h' U hU,
  rcases h'' with ⟨x, hx, h''⟩,
  cases normed_field.exists_norm_lt 𝕜 hx.left with y hy,
  have hy' : y ≠ 0 := norm_pos_iff.mp hy.1,
  let W := y • x.snd,
  rw ←filter.exists_mem_subset_iff,
  refine ⟨W, (set_smul_mem_nhds_zero_iff hy').mpr hx.2, _⟩,
  -- It remains to show that `W ⊆ balanced_core 𝕜 U`
  refine subset_balanced_core (mem_of_mem_nhds hU) (λ a ha, _),
  refine set.subset.trans (λ z hz, _) (set.maps_to'.mp h''),
  rw [set.image_prod, set.image2_smul],
  rw set.mem_smul_set at hz,
  rcases hz with ⟨z', hz', hz⟩,
  rw [←hz, set.mem_smul],
  refine ⟨a • y, y⁻¹ • z', _, _, _⟩,
  { rw [algebra.id.smul_eq_mul, mem_ball_zero_iff, norm_mul, ←one_mul x.fst],
    exact mul_lt_mul' ha hy.2 hy.1.le zero_lt_one },
  { convert set.smul_mem_smul_set hz',
    rw [←smul_assoc y⁻¹ y x.snd, smul_eq_mul, inv_mul_cancel hy', one_smul] },
  rw [smul_assoc, ←smul_assoc y y⁻¹ z', smul_eq_mul, mul_inv_cancel hy', one_smul],
end

variables (𝕜 E)

lemma nhds_basis_closed_balanced [regular_space E] : (𝓝 (0 : E)).has_basis
  (λ (s : set E), s ∈ 𝓝 (0 : E) ∧ is_closed s ∧ balanced 𝕜 s) id :=
begin
  refine (closed_nhds_basis 0).to_has_basis (λ s hs, _) (λ s hs, ⟨s, ⟨hs.1, hs.2.1⟩, rfl.subset⟩),
  refine ⟨balanced_core 𝕜 s, ⟨balanced_core_mem_nhds_zero hs.1, _⟩, balanced_core_subset s⟩,
  refine ⟨balanced_core_is_closed hs.2, balanced_core_balanced s⟩
end

end topology


/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Std.Data.Fin.Lemmas

import Algdata.Init.Nat

universe u v w

namespace Fin

theorem val_succ_eq_succ_val {n : Nat} (x : Fin n) : x.succ.val = x.val.succ := rfl

def pred {n : Nat} (x : Fin n) (h : x.val > 0) : Fin n.pred where
  val := x.val.pred
  isLt := Nat.pred_lt_pred (Nat.not_eq_zero_of_lt h) x.isLt

@[simp]
theorem subst_eq : ∀ {n k : Nat} {h : n = k} (x : Fin n), h ▸ x = ⟨x.val, h ▸ x.isLt⟩
| _, _, rfl, mk _ _ => rfl

@[simp]
theorem subst_val : ∀ {n k : Nat} {h : n = k} (x : Fin n), (h ▸ x).val = x.val
| _, _, rfl, mk _ _ => rfl

theorem lexfold_lt_mul {m n : Nat} (x : Fin m) (y : Fin n) : x.val * n + y.val < m*n :=
  calc
    x.val * n + y.val
      < x.val * n + n := Nat.add_lt_add_left y.isLt _
    _ = (x.val.succ)*n := (Nat.succ_mul x.val n).symm
    _ ≤ m * n := Nat.mul_le_mul_right n (Nat.succ_le_of_lt x.isLt)

theorem lexfold_inj {m n : Nat} {x₁ x₂: Fin m} {y₁ y₂ : Fin n} (h : x₁.val * n + y₁.val = x₂.val * n + y₂.val) : x₁=x₂ ∧ y₁=y₂ := by
  have : x₁.val = x₂.val ∧ y₁.val = y₂.val := Nat.div_mod_unique n y₁.isLt y₂.isLt h
  exact ⟨Fin.eq_of_val_eq this.left, Fin.eq_of_val_eq this.right⟩

-- Folding a product of two finite sets into a finite set in the lexicographical order
@[always_inline]
def lexFold {m n : Nat} (x : Fin m) (y : Fin n) : Fin (m*n) where
  val := x.val * n + y.val
  isLt := lexfold_lt_mul x y

def lexFold_inj {m n : Nat} {x₁ x₂ : Fin m} {y₁ y₂ : Fin n} (h : lexFold x₁ y₁ = lexFold x₂ y₂) : x₁ = x₂ ∧ y₁ = y₂ :=
  lexfold_inj (congrArg val h)

/--
Analogue of `Nat.foldM`; this traverses all elements of `Fin n` in the ascending order.
@todo Compare it with the following implementation regarding the perfomance:
```
@[inline]
def foldAllM' {α : Type u} (f : Fin n → α → m α) (init : α) : m α :=
  let rec @[specialize] loop : (k : Nat) → k ≤ n → α → m α
  | 0, _, x => pure x
  | k+1, h, x => f ⟨n-k-1, Nat.sub_lt_self k.zero_lt_succ h⟩ x >>= loop k (Nat.le_of_succ_le h)
  loop n n.le.refl init
```
-/
@[inline]
def foldAllM {m : Type u → Type v} [Monad m] {n : Nat} {α : Type u} (f : Fin n → α → m α) (init : α) : m α :=
  let rec @[specialize] loop (i : Nat) (x : α) : (k : Nat) → (i+k = n) → m α
  | 0, _ => pure x
  | k+1, h => do
    loop i.succ (← f ⟨i,Nat.lt_of_add_succ_eq h⟩ x) k (by rw [←h, Nat.add_succ, Nat.succ_add])
  loop 0 init n (Nat.zero_add n)

@[inline]
def foldAll {n : Nat} {α : Type u} (f : Fin n → α → α) (init : α) : α :=
  Id.run <| foldAllM f init

@[inline]
def forAllM {m : Type u → Type v} [Monad m] {n : Nat} (f : Fin n → m PUnit) : m PUnit :=
  let rec @[specialize] loop (i : Nat) : (k : Nat) → (i+k = n) → m PUnit
  | 0, _ => pure PUnit.unit
  | k+1, h => do
    f ⟨i,Nat.lt_of_add_succ_eq h⟩
    loop i.succ k (by rw [←h, Nat.add_succ, Nat.succ_add])
  loop 0 n (Nat.zero_add n)

theorem foldAllM.loop_succ {m : Type u → Type v} [Monad m] {α : Type u} {n : Nat} {f : Fin (n+1) → α → m α} {i : Nat} {a : α} {k : Nat} {h : i+(k+1)=n+1} : Fin.foldAllM.loop f i a (k+1) h = f ⟨i, Nat.lt_of_add_succ_eq h⟩ a >>= λ b => Fin.foldAllM.loop (f ∘ Fin.succ) i b k (Nat.succ.inj h) := by
  induction k generalizing n f i a
  case zero => rfl
  case succ k h_ind =>
    conv =>
      lhs
      change do loop f i.succ (← f ⟨i,Nat.lt_of_add_succ_eq h⟩ a) k.succ (by rw [←h]; rw [Nat.add_succ, Nat.succ_add, Nat.add_succ]; rfl)
    apply bind_congr; intro b
    rw [h_ind]
    rfl

theorem foldAllM_zero {m : Type u → Type v} [Monad m] {α : Type u} {init : α} {f : Fin 0 → α → m α} : Fin.foldAllM f init = pure (f:=m) init := rfl
theorem foldAllM_succ {m : Type u → Type v} [Monad m] {α : Type u} {init : α} {f : Fin n.succ → α → m α} : Fin.foldAllM f init = f ⟨0, Nat.zero_lt_succ n⟩ init >>= Fin.foldAllM (f ∘ Fin.succ) := by
  dsimp [foldAllM]; rw [Fin.foldAllM.loop_succ]

protected
def elementList : (n : Nat) → List (Fin n)
| 0 => []
| (n+1) => ⟨0, n.zero_lt_succ⟩ :: List.map (λ (⟨i,h⟩ : Fin n) => ⟨i+1, i.succ_lt_succ h⟩) (Fin.elementList n)

protected
theorem length_elementList (n : Nat) : List.length (Fin.elementList n) = n := by
  induction n
  case zero => rfl
  case succ n h_ind => unfold Fin.elementList; unfold List.length; rw [List.length_map, h_ind]

end Fin


/-
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 data.equiv.basic
import data.set.function

/-!
# Local equivalences

This files defines equivalences between subsets of given types.
An element `e` of `local_equiv α β` is made of two maps `e.to_fun` and `e.inv_fun` respectively
from α to β and from  β to α (just like equivs), which are inverse to each other on the subsets
`e.source` and `e.target` of respectively α and β.

They are designed in particular to define charts on manifolds.

The main functionality is `e.trans f`, which composes the two local equivalences by restricting
the source and target to the maximal set where the composition makes sense.

As for equivs, we register a coercion to functions and use it in our simp normal form: we write
`e x` and `e.symm y` instead of `e.to_fun x` and `e.inv_fun y`.

## Main definitions

`equiv.to_local_equiv`: associating a local equiv to an equiv, with source = target = univ
`local_equiv.symm`    : the inverse of a local equiv
`local_equiv.trans`   : the composition of two local equivs
`local_equiv.refl`    : the identity local equiv
`local_equiv.of_set`  : the identity on a set `s`
`eq_on_source`        : equivalence relation describing the "right" notion of equality for local
                        equivs (see below in implementation notes)

## Implementation notes

There are at least three possible implementations of local equivalences:
* equivs on subtypes
* pairs of functions taking values in `option α` and `option β`, equal to none where the local
equivalence is not defined
* pairs of functions defined everywhere, keeping the source and target as additional data

Each of these implementations has pros and cons.
* When dealing with subtypes, one still need to define additional API for composition and
restriction of domains. Checking that one always belongs to the right subtype makes things very
tedious, and leads quickly to DTT hell (as the subtype `u ∩ v` is not the "same" as `v ∩ u`, for
instance).
* With option-valued functions, the composition is very neat (it is just the usual composition, and
the domain is restricted automatically). These are implemented in `pequiv.lean`. For manifolds,
where one wants to discuss thoroughly the smoothness of the maps, this creates however a lot of
overhead as one would need to extend all classes of smoothness to option-valued maps.
* The local_equiv version as explained above is easier to use for manifolds. The drawback is that
there is extra useless data (the values of `to_fun` and `inv_fun` outside of `source` and `target`).
In particular, the equality notion between local equivs is not "the right one", i.e., coinciding
source and target and equality there. Moreover, there are no local equivs in this sense between
an empty type and a nonempty type. Since empty types are not that useful, and since one almost never
needs to talk about equal local equivs, this is not an issue in practice.
Still, we introduce an equivalence relation `eq_on_source` that captures this right notion of
equality, and show that many properties are invariant under this equivalence relation.

### Local coding conventions

If a lemma deals with the intersection of a set with either source or target of a `local_equiv`,
then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or `t ∩ e.target`.

-/

mk_simp_attribute mfld_simps "The simpset `mfld_simps` records several simp lemmas that are
especially useful in manifolds. It is a subset of the whole set of simp lemmas, but it makes it
possible to have quicker proofs (when used with `squeeze_simp` or `simp only`) while retaining
readability.

The typical use case is the following, in a file on manifolds:
If `simp [foo, bar]` is slow, replace it with `squeeze_simp [foo, bar] with mfld_simps` and paste
its output. The list of lemmas should be reasonable (contrary to the output of
`squeeze_simp [foo, bar]` which might contain tens of lemmas), and the outcome should be quick
enough.
"

-- register in the simpset `mfld_simps` several lemmas that are often useful when dealing
-- with manifolds
attribute [mfld_simps] id.def function.comp.left_id set.mem_set_of_eq set.image_eq_empty
set.univ_inter set.preimage_univ set.prod_mk_mem_set_prod_eq and_true set.mem_univ
set.mem_image_of_mem true_and set.mem_inter_eq set.mem_preimage function.comp_app
set.inter_subset_left set.mem_prod set.range_id set.range_prod_map and_self set.mem_range_self
eq_self_iff_true forall_const forall_true_iff set.inter_univ set.preimage_id function.comp.right_id
not_false_iff and_imp set.prod_inter_prod set.univ_prod_univ true_or or_true prod.map_mk
set.preimage_inter heq_iff_eq equiv.sigma_equiv_prod_apply equiv.sigma_equiv_prod_symm_apply
subtype.coe_mk equiv.to_fun_as_coe equiv.inv_fun_as_coe

/-- Common `@[simps]` configuration options used for manifold-related declarations. -/
def mfld_cfg : simps_cfg := {attrs := [`simp, `mfld_simps], fully_applied := ff}

namespace tactic.interactive

/-- A very basic tactic to show that sets showing up in manifolds coincide or are included in
one another. -/
meta def mfld_set_tac : tactic unit := do
  goal ← tactic.target,
  match goal with
  | `(%%e₁ = %%e₂) :=
      `[ext my_y,
        split;
        { assume h_my_y,
          try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
          simp only [*] with mfld_simps }]
  | `(%%e₁ ⊆ %%e₂) :=
      `[assume my_y h_my_y,
        try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
        simp only [*] with mfld_simps]
  | _ := tactic.fail "goal should be an equality or an inclusion"
  end

end tactic.interactive

open function set

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- Local equivalence between subsets `source` and `target` of α and β respectively. The (global)
maps `to_fun : α → β` and `inv_fun : β → α` map `source` to `target` and conversely, and are inverse
to each other there. The values of `to_fun` outside of `source` and of `inv_fun` outside of `target`
are irrelevant. -/
@[nolint has_inhabited_instance]
structure local_equiv (α : Type*) (β : Type*) :=
(to_fun      : α → β)
(inv_fun     : β → α)
(source      : set α)
(target      : set β)
(map_source' : ∀{x}, x ∈ source → to_fun x ∈ target)
(map_target' : ∀{x}, x ∈ target → inv_fun x ∈ source)
(left_inv'   : ∀{x}, x ∈ source → inv_fun (to_fun x) = x)
(right_inv'  : ∀{x}, x ∈ target → to_fun (inv_fun x) = x)

/-- Associating a local_equiv to an equiv-/
def equiv.to_local_equiv (e : α ≃ β) : local_equiv α β :=
{ to_fun      := e,
  inv_fun     := e.symm,
  source      := univ,
  target      := univ,
  map_source' := λx hx, mem_univ _,
  map_target' := λy hy, mem_univ _,
  left_inv'   := λx hx, e.left_inv x,
  right_inv'  := λx hx, e.right_inv x }

namespace local_equiv

variables (e : local_equiv α β) (e' : local_equiv β γ)

/-- The inverse of a local equiv -/
protected def symm : local_equiv β α :=
{ to_fun     := e.inv_fun,
  inv_fun    := e.to_fun,
  source     := e.target,
  target     := e.source,
  map_source' := e.map_target',
  map_target' := e.map_source',
  left_inv'   := e.right_inv',
  right_inv'  := e.left_inv' }

instance : has_coe_to_fun (local_equiv α β) (λ _, α → β) := ⟨local_equiv.to_fun⟩

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : local_equiv α β) : β → α := e.symm

initialize_simps_projections local_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp, mfld_simps] theorem coe_mk (f : α → β) (g s t ml mr il ir) :
  (local_equiv.mk f g s t ml mr il ir : α → β) = f := rfl

@[simp, mfld_simps] theorem coe_symm_mk (f : α → β) (g s t ml mr il ir) :
  ((local_equiv.mk f g s t ml mr il ir).symm : β → α) = g := rfl

@[simp, mfld_simps] lemma to_fun_as_coe : e.to_fun = e := rfl

@[simp, mfld_simps] lemma inv_fun_as_coe : e.inv_fun = e.symm := rfl

@[simp, mfld_simps] lemma map_source {x : α} (h : x ∈ e.source) : e x ∈ e.target :=
e.map_source' h

@[simp, mfld_simps] lemma map_target {x : β} (h : x ∈ e.target) : e.symm x ∈ e.source :=
e.map_target' h

@[simp, mfld_simps] lemma left_inv {x : α} (h : x ∈ e.source) : e.symm (e x) = x :=
e.left_inv' h

@[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
e.right_inv' h

protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
protected lemma right_inv_on : right_inv_on e.symm e e.target := λ x, e.right_inv
protected lemma inv_on : inv_on e.symm e e.source e.target := ⟨e.left_inv_on, e.right_inv_on⟩
protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on

/-- Create a copy of a `local_equiv` providing better definitional equalities. -/
@[simps] def copy (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := g,
  source := s,
  target := t,
  map_source' := λ x, ht ▸ hs ▸ hf ▸ e.map_source,
  map_target' := λ y, hs ▸ ht ▸ hg ▸ e.map_target,
  left_inv' := λ x, hs ▸ hf ▸ hg ▸ e.left_inv,
  right_inv' := λ x, ht ▸ hf ▸ hg ▸ e.right_inv }

lemma copy_eq_self (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  e.copy f hf g hg s hs t ht = e :=
by { substs f g s t, cases e, refl }

/-- Associating to a local_equiv an equiv between the source and the target -/
protected def to_equiv : equiv (e.source) (e.target) :=
{ to_fun    := λ x, ⟨e x, e.map_source x.mem⟩,
  inv_fun   := λ y, ⟨e.symm y, e.map_target y.mem⟩,
  left_inv  := λ⟨x, hx⟩, subtype.eq $ e.left_inv hx,
  right_inv := λ⟨y, hy⟩, subtype.eq $ e.right_inv hy }

@[simp, mfld_simps] lemma symm_source : e.symm.source = e.target := rfl
@[simp, mfld_simps] lemma symm_target : e.symm.target = e.source := rfl
@[simp, mfld_simps] lemma symm_symm : e.symm.symm = e := by { cases e, refl }

lemma image_source_eq_target : e '' e.source = e.target := e.bij_on.image_eq

/-- We say that `t : set β` is an image of `s : set α` under a local equivalence if
any of the following equivalent conditions hold:

* `e '' (e.source ∩ s) = e.target ∩ t`;
* `e.source ∩ e ⁻¹ t = e.source ∩ s`;
* `∀ x ∈ e.source, e x ∈ t ↔ x ∈ s` (this one is used in the definition).
-/
def is_image (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ e.source → (e x ∈ t ↔ x ∈ s)

namespace is_image

variables {e} {s : set α} {t : set β} {x : α} {y : β}

lemma apply_mem_iff (h : e.is_image s t) (hx : x ∈ e.source) : e x ∈ t ↔ x ∈ s := h hx

lemma symm_apply_mem_iff (h : e.is_image s t) : ∀ ⦃y⦄, y ∈ e.target → (e.symm y ∈ s ↔ y ∈ t) :=
by { rw [← e.image_source_eq_target, ball_image_iff], intros x hx, rw [e.left_inv hx, h hx] }

protected lemma symm (h : e.is_image s t) : e.symm.is_image t s := h.symm_apply_mem_iff

@[simp] lemma symm_iff : e.symm.is_image t s ↔ e.is_image s t := ⟨λ h, h.symm, λ h, h.symm⟩

protected lemma maps_to (h : e.is_image s t) : maps_to e (e.source ∩ s) (e.target ∩ t) :=
λ x hx, ⟨e.maps_to hx.1, (h hx.1).2 hx.2⟩

lemma symm_maps_to (h : e.is_image s t) : maps_to e.symm (e.target ∩ t) (e.source ∩ s) :=
h.symm.maps_to

/-- Restrict a `local_equiv` to a pair of corresponding sets. -/
@[simps] def restr (h : e.is_image s t) : local_equiv α β :=
{ to_fun := e,
  inv_fun := e.symm,
  source := e.source ∩ s,
  target := e.target ∩ t,
  map_source' := h.maps_to,
  map_target' := h.symm_maps_to,
  left_inv' := e.left_inv_on.mono (inter_subset_left _ _),
  right_inv' := e.right_inv_on.mono (inter_subset_left _ _) }

lemma image_eq (h : e.is_image s t) : e '' (e.source ∩ s) = e.target ∩ t :=
h.restr.image_source_eq_target

lemma symm_image_eq (h : e.is_image s t) : e.symm '' (e.target ∩ t) = e.source ∩ s :=
h.symm.image_eq

lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
by simp only [is_image, set.ext_iff, mem_inter_eq, and.congr_right_iff, mem_preimage]

alias iff_preimage_eq ↔ local_equiv.is_image.preimage_eq local_equiv.is_image.of_preimage_eq

lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
symm_iff.symm.trans iff_preimage_eq

alias iff_symm_preimage_eq ↔ local_equiv.is_image.symm_preimage_eq
  local_equiv.is_image.of_symm_preimage_eq

lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
of_symm_preimage_eq $ eq.trans (of_symm_preimage_eq rfl).image_eq.symm h

lemma of_symm_image_eq (h : e.symm '' (e.target ∩ t) = e.source ∩ s) : e.is_image s t :=
of_preimage_eq $ eq.trans (of_preimage_eq rfl).symm_image_eq.symm h

protected lemma compl (h : e.is_image s t) : e.is_image sᶜ tᶜ :=
λ x hx, not_congr (h hx)

protected lemma inter {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∩ s') (t ∩ t') :=
λ x hx, and_congr (h hx) (h' hx)

protected lemma union {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∪ s') (t ∪ t') :=
λ x hx, or_congr (h hx) (h' hx)

protected lemma diff {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s \ s') (t \ t') :=
h.inter h'.compl

lemma left_inv_on_piecewise {e' : local_equiv α β} [∀ i, decidable (i ∈ s)] [∀ i, decidable (i ∈ t)]
  (h : e.is_image s t) (h' : e'.is_image s t) :
  left_inv_on (t.piecewise e.symm e'.symm) (s.piecewise e e') (s.ite e.source e'.source) :=
begin
  rintro x (⟨he, hs⟩|⟨he, hs : x ∉ s⟩),
  { rw [piecewise_eq_of_mem _ _ _ hs, piecewise_eq_of_mem _ _ _ ((h he).2 hs), e.left_inv he], },
  { rw [piecewise_eq_of_not_mem _ _ _ hs, piecewise_eq_of_not_mem _ _ _ ((h'.compl he).2 hs),
      e'.left_inv he] }
end

lemma inter_eq_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (h' : e'.is_image s t) (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  e.target ∩ t = e'.target ∩ t :=
by rw [← h.image_eq, ← h'.image_eq, ← hs, Heq.image_eq]

lemma symm_eq_on_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  eq_on e.symm e'.symm (e.target ∩ t) :=
begin
  rw [← h.image_eq],
  rintros y ⟨x, hx, rfl⟩,
  have hx' := hx, rw hs at hx',
  rw [e.left_inv hx.1, Heq hx, e'.left_inv hx'.1]
end

end is_image

lemma is_image_source_target : e.is_image e.source e.target := λ x hx, by simp [hx]

lemma is_image_source_target_of_disjoint (e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) :
  e.is_image e'.source e'.target :=
assume x hx,
have x ∉ e'.source, from λ hx', hs ⟨hx, hx'⟩,
have e x ∉ e'.target, from λ hx', ht ⟨e.maps_to hx, hx'⟩,
by simp only *

lemma image_source_inter_eq' (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s :=
by rw [inter_comm, e.left_inv_on.image_inter', image_source_eq_target, inter_comm]

lemma image_source_inter_eq (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' (e.source ∩ s) :=
by rw [inter_comm, e.left_inv_on.image_inter, image_source_eq_target, inter_comm]

lemma image_eq_target_inter_inv_preimage {s : set α} (h : s ⊆ e.source) :
  e '' s = e.target ∩ e.symm ⁻¹' s :=
by rw [← e.image_source_inter_eq', inter_eq_self_of_subset_right h]

lemma symm_image_eq_source_inter_preimage {s : set β} (h : s ⊆ e.target) :
  e.symm '' s = e.source ∩ e ⁻¹' s :=
e.symm.image_eq_target_inter_inv_preimage h

lemma symm_image_target_inter_eq (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' (e.target ∩ s) :=
e.symm.image_source_inter_eq _

lemma symm_image_target_inter_eq' (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
e.symm.image_source_inter_eq' _

lemma source_inter_preimage_inv_preimage (s : set α) :
  e.source ∩ e ⁻¹' (e.symm ⁻¹' s) = e.source ∩ s :=
set.ext $ λ x, and.congr_right_iff.2 $ λ hx, by simp only [mem_preimage, e.left_inv hx]

lemma source_inter_preimage_target_inter (s : set β) :
  e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
ext $ λ x, ⟨λ hx, ⟨hx.1, hx.2.2⟩, λ hx, ⟨hx.1, e.map_source hx.1, hx.2⟩⟩

lemma target_inter_inv_preimage_preimage (s : set β) :
  e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
e.symm.source_inter_preimage_inv_preimage _

lemma source_subset_preimage_target : e.source ⊆ e ⁻¹' e.target :=
e.maps_to

lemma symm_image_target_eq_source : e.symm '' e.target = e.source :=
e.symm.image_source_eq_target

lemma target_subset_preimage_source : e.target ⊆ e.symm ⁻¹' e.source :=
e.symm_maps_to

/-- Two local equivs that have the same `source`, same `to_fun` and same `inv_fun`, coincide. -/
@[ext]
protected lemma ext {e e' : local_equiv α β} (h : ∀x, e x = e' x)
  (hsymm : ∀x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' :=
begin
  have A : (e : α → β) = e', by { ext x, exact h x },
  have B : (e.symm : β → α) = e'.symm, by { ext x, exact hsymm x },
  have I : e '' e.source = e.target := e.image_source_eq_target,
  have I' : e' '' e'.source = e'.target := e'.image_source_eq_target,
  rw [A, hs, I'] at I,
  cases e; cases e',
  simp * at *
end

/-- Restricting a local equivalence to e.source ∩ s -/
protected def restr (s : set α) : local_equiv α β :=
(@is_image.of_symm_preimage_eq α β e s (e.symm ⁻¹' s) rfl).restr

@[simp, mfld_simps] lemma restr_coe (s : set α) : (e.restr s : α → β) = e := rfl
@[simp, mfld_simps] lemma restr_coe_symm (s : set α) : ((e.restr s).symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma restr_source (s : set α) : (e.restr s).source = e.source ∩ s := rfl
@[simp, mfld_simps] lemma restr_target (s : set α) :
  (e.restr s).target = e.target ∩ e.symm ⁻¹' s := rfl

lemma restr_eq_of_source_subset {e : local_equiv α β} {s : set α} (h : e.source ⊆ s) :
  e.restr s = e :=
local_equiv.ext (λ_, rfl) (λ_, rfl) (by simp [inter_eq_self_of_subset_left h])

@[simp, mfld_simps] lemma restr_univ {e : local_equiv α β} : e.restr univ = e :=
restr_eq_of_source_subset (subset_univ _)

/-- The identity local equiv -/
protected def refl (α : Type*) : local_equiv α α := (equiv.refl α).to_local_equiv

@[simp, mfld_simps] lemma refl_source : (local_equiv.refl α).source = univ := rfl
@[simp, mfld_simps] lemma refl_target : (local_equiv.refl α).target = univ := rfl
@[simp, mfld_simps] lemma refl_coe : (local_equiv.refl α : α → α) = id := rfl
@[simp, mfld_simps] lemma refl_symm : (local_equiv.refl α).symm = local_equiv.refl α := rfl

@[simp, mfld_simps] lemma refl_restr_source (s : set α) :
  ((local_equiv.refl α).restr s).source = s :=
by simp

@[simp, mfld_simps] lemma refl_restr_target (s : set α) :
  ((local_equiv.refl α).restr s).target = s :=
by { change univ ∩ id⁻¹' s = s, simp }

/-- The identity local equiv on a set `s` -/
def of_set (s : set α) : local_equiv α α :=
{ to_fun      := id,
  inv_fun     := id,
  source      := s,
  target      := s,
  map_source' := λx hx, hx,
  map_target' := λx hx, hx,
  left_inv'   := λx hx, rfl,
  right_inv'  := λx hx, rfl }

@[simp, mfld_simps] lemma of_set_source (s : set α) : (local_equiv.of_set s).source = s := rfl
@[simp, mfld_simps] lemma of_set_target (s : set α) : (local_equiv.of_set s).target = s := rfl
@[simp, mfld_simps] lemma of_set_coe (s : set α) : (local_equiv.of_set s : α → α) = id := rfl
@[simp, mfld_simps] lemma of_set_symm (s : set α) :
  (local_equiv.of_set s).symm = local_equiv.of_set s := rfl

/-- Composing two local equivs if the target of the first coincides with the source of the
second. -/
protected def trans' (e' : local_equiv β γ) (h : e.target = e'.source) :
  local_equiv α γ :=
{ to_fun := e' ∘ e,
  inv_fun := e.symm ∘ e'.symm,
  source := e.source,
  target := e'.target,
  map_source' := λx hx, by simp [h.symm, hx],
  map_target' := λy hy, by simp [h, hy],
  left_inv' := λx hx, by simp [hx, h.symm],
  right_inv' := λy hy, by simp [hy, h] }

/-- Composing two local equivs, by restricting to the maximal domain where their composition
is well defined. -/
protected def trans : local_equiv α γ :=
  local_equiv.trans' (e.symm.restr (e'.source)).symm (e'.restr (e.target)) (inter_comm _ _)

@[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
@[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl

lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
by cases e; cases e'; refl

@[simp, mfld_simps] lemma trans_source : (e.trans e').source = e.source ∩ e ⁻¹' e'.source := rfl

lemma trans_source' : (e.trans e').source = e.source ∩ e ⁻¹' (e.target ∩ e'.source) :=
by mfld_set_tac

lemma trans_source'' : (e.trans e').source = e.symm '' (e.target ∩ e'.source) :=
by rw [e.trans_source', e.symm_image_target_inter_eq]

lemma image_trans_source : e '' (e.trans e').source = e.target ∩ e'.source :=
(e.symm.restr e'.source).symm.image_source_eq_target

@[simp, mfld_simps] lemma trans_target :
  (e.trans e').target = e'.target ∩ e'.symm ⁻¹' e.target := rfl

lemma trans_target' : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' (e'.source ∩ e.target) :=
trans_source' e'.symm e.symm

lemma trans_target'' : (e.trans e').target = e' '' (e'.source ∩ e.target) :=
trans_source'' e'.symm e.symm

lemma inv_image_trans_target : e'.symm '' (e.trans e').target = e'.source ∩ e.target :=
image_trans_source e'.symm e.symm

lemma trans_assoc (e'' : local_equiv γ δ) : (e.trans e').trans e'' = e.trans (e'.trans e'') :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, @preimage_comp α β γ, inter_assoc])

@[simp, mfld_simps] lemma trans_refl : e.trans (local_equiv.refl β) = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

@[simp, mfld_simps] lemma refl_trans : (local_equiv.refl α).trans e = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, preimage_id])

lemma trans_refl_restr (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

lemma trans_refl_restr' (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e.source ∩ e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source], rw [← inter_assoc, inter_self] }

lemma restr_trans (s : set α) :
  (e.restr s).trans e' = (e.trans e').restr s :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source, inter_comm], rwa inter_assoc }

/-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. Then `e`
and `e'` should really be considered the same local equiv. -/
def eq_on_source (e e' : local_equiv α β) : Prop :=
e.source = e'.source ∧ (e.source.eq_on e e')

/-- `eq_on_source` is an equivalence relation -/
instance eq_on_source_setoid : setoid (local_equiv α β) :=
{ r     := eq_on_source,
  iseqv := ⟨
    λe, by simp [eq_on_source],
    λe e' h, by { simp [eq_on_source, h.1.symm], exact λx hx, (h.2 hx).symm },
    λe e' e'' h h', ⟨by rwa [← h'.1, ← h.1], λx hx, by { rw [← h'.2, h.2 hx], rwa ← h.1 }⟩⟩ }

lemma eq_on_source_refl : e ≈ e := setoid.refl _

/-- Two equivalent local equivs have the same source -/
lemma eq_on_source.source_eq {e e' : local_equiv α β} (h : e ≈ e') : e.source = e'.source :=
h.1

/-- Two equivalent local equivs coincide on the source -/
lemma eq_on_source.eq_on {e e' : local_equiv α β} (h : e ≈ e') : e.source.eq_on e e' :=
h.2

/-- Two equivalent local equivs have the same target -/
lemma eq_on_source.target_eq {e e' : local_equiv α β} (h : e ≈ e') : e.target = e'.target :=
by simp only [← image_source_eq_target, ← h.source_eq, h.2.image_eq]

/-- If two local equivs are equivalent, so are their inverses. -/
lemma eq_on_source.symm' {e e' : local_equiv α β} (h : e ≈ e') : e.symm ≈ e'.symm :=
begin
  refine ⟨h.target_eq, eq_on_of_left_inv_on_of_right_inv_on e.left_inv_on _ _⟩;
    simp only [symm_source, h.target_eq, h.source_eq, e'.symm_maps_to],
  exact e'.right_inv_on.congr_right e'.symm_maps_to (h.source_eq ▸ h.eq_on.symm),
end

/-- Two equivalent local equivs have coinciding inverses on the target -/
lemma eq_on_source.symm_eq_on {e e' : local_equiv α β} (h : e ≈ e') :
  eq_on e.symm e'.symm e.target :=
h.symm'.eq_on

/-- Composition of local equivs respects equivalence -/
lemma eq_on_source.trans' {e e' : local_equiv α β} {f f' : local_equiv β γ}
  (he : e ≈ e') (hf : f ≈ f') : e.trans f ≈ e'.trans f' :=
begin
  split,
  { rw [trans_source'', trans_source'', ← he.target_eq, ← hf.1],
    exact (he.symm'.eq_on.mono $ inter_subset_left _ _).image_eq },
  { assume x hx,
    rw trans_source at hx,
    simp [(he.2 hx.1).symm, hf.2 hx.2] }
end

/-- Restriction of local equivs respects equivalence -/
lemma eq_on_source.restr {e e' : local_equiv α β} (he : e ≈ e') (s : set α) :
  e.restr s ≈ e'.restr s :=
begin
  split,
  { simp [he.1] },
  { assume x hx,
    simp only [mem_inter_eq, restr_source] at hx,
    exact he.2 hx.1 }
end

/-- Preimages are respected by equivalence -/
lemma eq_on_source.source_inter_preimage_eq {e e' : local_equiv α β} (he : e ≈ e') (s : set β) :
  e.source ∩ e ⁻¹' s = e'.source ∩ e' ⁻¹' s :=
by rw [he.eq_on.inter_preimage_eq, he.source_eq]

/-- Composition of a local equiv and its inverse is equivalent to the restriction of the identity
to the source -/
lemma trans_self_symm :
  e.trans e.symm ≈ local_equiv.of_set e.source :=
begin
  have A : (e.trans e.symm).source = e.source, by mfld_set_tac,
  refine ⟨by simp [A], λx hx, _⟩,
  rw A at hx,
  simp only [hx] with mfld_simps
end

/-- Composition of the inverse of a local equiv and this local equiv is equivalent to the
restriction of the identity to the target -/
lemma trans_symm_self :
  e.symm.trans e ≈ local_equiv.of_set e.target :=
trans_self_symm (e.symm)

/-- Two equivalent local equivs are equal when the source and target are univ -/
lemma eq_of_eq_on_source_univ (e e' : local_equiv α β) (h : e ≈ e')
  (s : e.source = univ) (t : e.target = univ) : e = e' :=
begin
  apply local_equiv.ext (λx, _) (λx, _) h.1,
  { apply h.2,
    rw s,
    exact mem_univ _ },
  { apply h.symm'.2,
    rw [symm_source, t],
    exact mem_univ _ }
end

section prod

/-- The product of two local equivs, as a local equiv on the product. -/
def prod (e : local_equiv α β) (e' : local_equiv γ δ) : local_equiv (α × γ) (β × δ) :=
{ source := set.prod e.source e'.source,
  target := set.prod e.target e'.target,
  to_fun := λp, (e p.1, e' p.2),
  inv_fun := λp, (e.symm p.1, e'.symm p.2),
  map_source' := λp hp, by { simp at hp, simp [hp] },
  map_target' := λp hp, by { simp at hp, simp [map_target, hp] },
  left_inv'   := λp hp, by { simp at hp, simp [hp] },
  right_inv'  := λp hp, by { simp at hp, simp [hp] } }

@[simp, mfld_simps] lemma prod_source (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').source = set.prod e.source e'.source := rfl

@[simp, mfld_simps] lemma prod_target (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').target = set.prod e.target e'.target := rfl

@[simp, mfld_simps] lemma prod_coe (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e') : α × γ → β × δ) = (λp, (e p.1, e' p.2)) := rfl

lemma prod_coe_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e').symm : β × δ → α × γ) = (λp, (e.symm p.1, e'.symm p.2)) := rfl

@[simp, mfld_simps] lemma prod_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').symm = (e.symm.prod e'.symm) :=
by ext x; simp [prod_coe_symm]

@[simp, mfld_simps] lemma prod_trans {η : Type*} {ε : Type*}
  (e : local_equiv α β) (f : local_equiv β γ) (e' : local_equiv δ η) (f' : local_equiv η ε) :
  (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') :=
by ext x; simp [ext_iff]; tauto

end prod

/-- Combine two `local_equiv`s using `set.piecewise`. The source of the new `local_equiv` is
`s.ite e.source e'.source = e.source ∩ s ∪ e'.source \ s`, and similarly for target.  The function
sends `e.source ∩ s` to `e.target ∩ t` using `e` and `e'.source \ s` to `e'.target \ t` using `e'`,
and similarly for the inverse function. The definition assumes `e.is_image s t` and
`e'.is_image s t`. -/
@[simps] def piecewise (e e' : local_equiv α β) (s : set α) (t : set β)
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t) :
  local_equiv α β :=
{ to_fun := s.piecewise e e',
  inv_fun := t.piecewise e.symm e'.symm,
  source := s.ite e.source e'.source,
  target := t.ite e.target e'.target,
  map_source' := H.maps_to.piecewise_ite H'.compl.maps_to,
  map_target' := H.symm.maps_to.piecewise_ite H'.symm.compl.maps_to,
  left_inv' := H.left_inv_on_piecewise H',
  right_inv' := H.symm.left_inv_on_piecewise H'.symm }

lemma symm_piecewise (e e' : local_equiv α β) {s : set α} {t : set β}
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)]
  (H : e.is_image s t) (H' : e'.is_image s t) :
  (e.piecewise e' s t H H').symm = e.symm.piecewise e'.symm t s H.symm H'.symm :=
rfl

/-- Combine two `local_equiv`s with disjoint sources and disjoint targets. We reuse
`local_equiv.piecewise`, then override `source` and `target` to ensure better definitional
equalities. -/
@[simps] def disjoint_union (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  local_equiv α β :=
(e.piecewise e' e.source e.target e.is_image_source_target $
  e'.is_image_source_target_of_disjoint _ hs.symm ht.symm).copy
  _ rfl _ rfl (e.source ∪ e'.source) (ite_left _ _) (e.target ∪ e'.target) (ite_left _ _)

lemma disjoint_union_eq_piecewise (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  e.disjoint_union e' hs ht = e.piecewise e' e.source e.target e.is_image_source_target
    (e'.is_image_source_target_of_disjoint _ hs.symm ht.symm) :=
copy_eq_self _ _ _ _ _ _ _ _ _

section pi

variables {ι : Type*} {αi βi : ι → Type*} (ei : Π i, local_equiv (αi i) (βi i))

/-- The product of a family of local equivs, as a local equiv on the pi type. -/
@[simps source target] protected def pi : local_equiv (Π i, αi i) (Π i, βi i) :=
{ to_fun := λ f i, ei i (f i),
  inv_fun := λ f i, (ei i).symm (f i),
  source := pi univ (λ i, (ei i).source),
  target := pi univ (λ i, (ei i).target),
  map_source' := λ f hf i hi, (ei i).map_source (hf i hi),
  map_target' := λ f hf i hi, (ei i).map_target (hf i hi),
  left_inv' := λ f hf, funext $ λ i, (ei i).left_inv (hf i trivial),
  right_inv' := λ f hf, funext $ λ i, (ei i).right_inv (hf i trivial) }

attribute [mfld_simps] pi_source pi_target

@[simp, mfld_simps] lemma pi_coe : ⇑(local_equiv.pi ei) = λ (f : Π i, αi i) i, ei i (f i) := rfl
@[simp, mfld_simps] lemma pi_symm :
  (local_equiv.pi ei).symm = local_equiv.pi (λ i, (ei i).symm) := rfl

end pi

end local_equiv

namespace set

-- All arguments are explicit to avoid missing information in the pretty printer output
/-- A bijection between two sets `s : set α` and `t : set β` provides a local equivalence
between `α` and `β`. -/
@[simps] noncomputable def bij_on.to_local_equiv [nonempty α] (f : α → β) (s : set α) (t : set β)
  (hf : bij_on f s t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := inv_fun_on f s,
  source := s,
  target := t,
  map_source' := hf.maps_to,
  map_target' := hf.surj_on.maps_to_inv_fun_on,
  left_inv'   := hf.inv_on_inv_fun_on.1,
  right_inv'  := hf.inv_on_inv_fun_on.2 }

/-- A map injective on a subset of its domain provides a local equivalence. -/
@[simp, mfld_simps] noncomputable def inj_on.to_local_equiv [nonempty α] (f : α → β) (s : set α)
  (hf : inj_on f s) :
  local_equiv α β :=
hf.bij_on_image.to_local_equiv f s (f '' s)

end set

namespace equiv
/- equivs give rise to local_equiv. We set up simp lemmas to reduce most properties of the local
equiv to that of the equiv. -/
variables (e : equiv α β) (e' : equiv β γ)

@[simp, mfld_simps] lemma to_local_equiv_coe : (e.to_local_equiv : α → β) = e := rfl
@[simp, mfld_simps] lemma to_local_equiv_symm_coe : (e.to_local_equiv.symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma to_local_equiv_source : e.to_local_equiv.source = univ := rfl
@[simp, mfld_simps] lemma to_local_equiv_target : e.to_local_equiv.target = univ := rfl
@[simp, mfld_simps] lemma refl_to_local_equiv :
  (equiv.refl α).to_local_equiv = local_equiv.refl α := rfl
@[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
@[simp, mfld_simps] lemma trans_to_local_equiv :
  (e.trans e').to_local_equiv = e.to_local_equiv.trans e'.to_local_equiv :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [local_equiv.trans_source, equiv.to_local_equiv])

end equiv


import linear_algebra.tensor_power
import analysis.inner_product_space.pi_L2
import to_mathlib.analysis.inner_product_space.tensor_product
import to_mathlib.analysis.inner_product_space.tensor_power
import to_mathlib.combinatorics.simple_graph.strong_product
import to_mathlib.combinatorics.simple_graph.independent
import algebra.order.field
import algebra.order.monoid
import topology.algebra.order.basic

noncomputable theory

open set function
open_locale real_inner_product_space tensor_product big_operators pointwise

namespace simple_graph

variables {V : Type*} (G : simple_graph V) (E : Type*) [inner_product_space ℝ E]

/-- An orthogonal representation of a graph. -/
structure orthogonal_representation :=
(to_fun : V → E)
(norm_eq_one' : ∀ v, ∥to_fun v∥ = 1)
(inner_eq_zero_of_ne_of_not_adj' : ∀ v w, v ≠ w → ¬ G.adj v w → ⟪to_fun v, to_fun w⟫ = 0)

namespace orthogonal_representation

/-- see Note [function coercion] -/
instance : has_coe_to_fun (orthogonal_representation G E) (λ _, V → E) := ⟨λ ρ, ρ.to_fun⟩

/-- Any finite graph has an orthogonal representation whose dimension is equal to its number of
vertices. The special situation is thus when there is an orthogonal representation into a space
of strictly smaller dimension.

We won't actually need this instance in this project but it might be useful practice to fill in the
proofs below. -/
instance [fintype V] [decidable_eq V] :
  inhabited (G.orthogonal_representation (euclidean_space ℝ V)) :=
⟨{ to_fun := λ v, euclidean_space.single v 1,
   norm_eq_one' := λ v, begin
    rw [norm_eq_sqrt_real_inner, real.sqrt_eq_iff_mul_self_eq, one_mul,
      euclidean_space.inner_single_left, map_one, one_mul, euclidean_space.single_apply, if_pos rfl],
    exact real_inner_self_nonneg, norm_num,
   end,
   inner_eq_zero_of_ne_of_not_adj' := λ v w h nadj, begin
    rw [euclidean_space.inner_single_left, map_one, one_mul, euclidean_space.single_apply, if_neg h],
   end, }⟩

variables {G E} (ρ : orthogonal_representation G E)

@[simp] lemma norm_eq_one {v : V} : ∥ρ v∥ = 1 :=
ρ.norm_eq_one' v

@[simp] lemma inner_self_eq_one (v : V) : inner (ρ v) (ρ v) = (1 : ℝ) :=
begin
  have : ∥ρ v∥ = 1 := ρ.norm_eq_one,
  rw [norm_eq_sqrt_inner, real.sqrt_eq_iff_mul_self_eq, mul_one, is_R_or_C.re_to_real] at this,
  exact this.symm, exact real_inner_self_nonneg, norm_num,
end

lemma inner_eq_zero_of_ne_of_not_adj {v w : V} (h₁ : v ≠ w) (h₂ : ¬ G.adj v w) :
  ⟪ρ v, ρ w⟫ = 0 :=
ρ.inner_eq_zero_of_ne_of_not_adj' v w h₁ h₂

lemma orthonormal_on_independent (I : set V) (hI : G.independent_set I) :
  orthonormal ℝ (I.restrict ρ) :=
⟨λ _, ρ.norm_eq_one, λ i j h, ρ.inner_eq_zero_of_ne_of_not_adj (λ r, h $ subtype.ext r) $ hI i j⟩

/-- The Lovász number of an orthogonal representation of a graph at a vector `e`. -/
def lovasz_number_at (e : E) : ℝ :=
⨆ v, ∥e∥^2 / ⟪ρ v, e⟫^2

@[simp] lemma lovasz_number_at_nneg (e : E) :
  0 ≤ ρ.lovasz_number_at e :=
  begin
    apply real.Sup_nonneg,
    intro,
    unfold range,
    intro h₀,
    cases h₀ with v h,
    rw ← div_pow at h,
    rw ← h,
    apply sq_nonneg,
  end

lemma lovasz_number_at_eq_csupr (e : E) :
  ρ.lovasz_number_at e = ⨆ v, ∥e∥^2 / ⟪ρ v, e⟫^2 :=
rfl

lemma independence_number_le_lovasz_number_at [fintype V] (e : E) :
  (G.independence_number : ℝ) ≤ ρ.lovasz_number_at e :=
sorry

variables {W F : Type*} {H : simple_graph W}
variables [inner_product_space ℝ F] (ρ' : orthogonal_representation H F)

/-- If `ρ` is an orthogonal representation of a graph `G` in `E` and `ρ'` is an orthogonal
representation of a graph `H` in `F`, then `(x, y) ↦ (ρ x) ⊗ₜ (ρ' y)` defines an orthogonal
representation of the graph `G.strong_prod H` on `E ⊗ F`.

Actually we probably won't need this definition for this project but it might be good practice
to fill in the proofs below. -/
@[simps] def prod : orthogonal_representation (G.strong_prod H) (E ⊗[ℝ] F) :=
{ to_fun := λ x, (ρ x.1) ⊗ₜ (ρ' x.2),
  norm_eq_one' := λ ⟨v, w⟩, begin
    rw [norm_eq_sqrt_real_inner, real.sqrt_eq_iff_mul_self_eq, one_mul,
      inner_product_space.inner_tprod, ρ.inner_self_eq_one, one_mul,
      ρ'.inner_self_eq_one],
    exact real_inner_self_nonneg, norm_num,
  end,
  inner_eq_zero_of_ne_of_not_adj' := λ ⟨v, w⟩ ⟨v', w'⟩ neq nadj,
  begin
    rw [simple_graph.strong_prod_adj, not_and_distrib, not_not, not_and_distrib,
      not_or_distrib, not_or_distrib] at nadj,
    rw [inner_product_space.inner_tprod],
    dsimp only at nadj,
    rcases nadj with h|⟨h1, h2⟩|⟨h1, h2⟩,
    { exact false.elim (neq h) },
    { rw [ρ.inner_eq_zero_of_ne_of_not_adj h1 h2, zero_mul] },
    { rw [ρ'.inner_eq_zero_of_ne_of_not_adj h1 h2, mul_zero] },
  end, }

lemma real.Sup_mul_Sup
  (s : set ℝ) (hs : ∀ (a : ℝ), a ∈ s → 0 ≤ a)
  (t : set ℝ) (ht : ∀ (a : ℝ), a ∈ t → 0 ≤ a):
  Sup s * Sup t = Sup (s * t) :=
begin
  have le1 : 0 ≤ Sup s := real.Sup_nonneg _ hs,
  have le2 : 0 ≤ Sup t := real.Sup_nonneg _ ht,
  obtain rfl | hs1 := s.eq_empty_or_nonempty,
  { rw [real.Sup_empty, zero_mul, set.empty_mul, real.Sup_empty], },
  obtain rfl | ht1 := t.eq_empty_or_nonempty,
  { rw [real.Sup_empty, mul_zero, set.mul_empty, real.Sup_empty], },
  have hst1 : (s * t).nonempty := ⟨hs1.some * ht1.some, ⟨_, _, hs1.some_spec, ht1.some_spec, rfl⟩⟩,
  obtain rfl | hs0 := eq_or_ne s {0},
  { rw [cSup_singleton, zero_mul, show {(0 : ℝ)} * t = {0}, from _, cSup_singleton],
    ext1, split,
    { rintros ⟨x, y, hx, hy, rfl⟩,
      rw set.mem_singleton_iff at hx ⊢,
      rw [hx, zero_mul], },
    { rintros hx, rw set.mem_singleton_iff at hx, rw hx,
      exact ⟨0, ht1.some, set.mem_singleton _, ht1.some_spec, zero_mul _⟩, } },
  obtain rfl | ht0 := eq_or_ne t {0},
  { rw [cSup_singleton, mul_zero, show s * {(0 : ℝ)} = {0}, from _, cSup_singleton],
    ext1, split,
    { rintros ⟨x, y, hx, hy, rfl⟩,
      rw set.mem_singleton_iff at hy ⊢,
      rw [hy, mul_zero], },
    { rintros hx, rw set.mem_singleton_iff at hx, rw hx,
      exact ⟨hs1.some, 0, hs1.some_spec, set.mem_singleton _, mul_zero _⟩, } },
  replace hs0 : ∃ x : ℝ, x ∈ s ∧ x ≠ 0,
  { contrapose! hs0, rw eq_singleton_iff_nonempty_unique_mem,
    refine ⟨hs1, hs0⟩, },
  replace ht0 : ∃ x : ℝ, x ∈ t ∧ x ≠ 0,
  { contrapose! ht0, rw eq_singleton_iff_nonempty_unique_mem,
    refine ⟨ht1, ht0⟩, },
  by_cases hs2 : ¬bdd_above s,
  { rw [real.Sup_def s, dif_neg, zero_mul, real.Sup_def, dif_neg],
    rw [not_and_distrib], right, contrapose! hs2,
    rcases hs2 with ⟨M, hM⟩,
    refine ⟨M/ht0.some, λ x hx, _⟩,
    specialize hM ⟨x, ht0.some, hx, ht0.some_spec.1, rfl⟩,
    rwa le_div_iff, apply lt_of_le_of_ne, exact ht _ ht0.some_spec.1,
    exact ht0.some_spec.2.symm,
    rw [not_and_distrib], right, assumption, },
  by_cases ht2 : ¬bdd_above t,
  { rw [real.Sup_def t, dif_neg, mul_zero, real.Sup_def, dif_neg],
    rw [not_and_distrib], right, contrapose! ht2,
    rcases ht2 with ⟨M, hM⟩,
    refine ⟨M/hs0.some, λ x hx, _⟩,
    specialize hM ⟨hs0.some, x, hs0.some_spec.1, hx, rfl⟩,
    rwa [le_div_iff, mul_comm], apply lt_of_le_of_ne, exact hs _ hs0.some_spec.1,
    exact hs0.some_spec.2.symm,
    rw [not_and_distrib], right, assumption, },
  rw not_not at hs2 ht2,
  have hst2 : bdd_above (s * t) := ⟨hs2.some * ht2.some, begin
    rintros _ ⟨x, y, hx, hy, rfl⟩, apply mul_le_mul,
    exact hs2.some_spec hx, exact ht2.some_spec hy, exact ht _ hy,
    refine (hs _ hs1.some_spec).trans (hs2.some_spec hs1.some_spec),
  end⟩,

  apply le_antisymm,
  { obtain ⟨a, ha1, ha2, ha3⟩ := exists_seq_tendsto_Sup hs1 hs2,
    obtain ⟨b, hb1, hb2, hb3⟩ := exists_seq_tendsto_Sup ht1 ht2,
    let c : ℕ → ℝ := λ n, a n * b n,
    have hc1 : monotone c := monotone.mul ha1 hb1 (λ x, hs _ (ha3 _)) (λ x, ht _ (hb3 _)),
    have hc2 : filter.tendsto c filter.at_top (nhds (Sup s * Sup t)) := filter.tendsto.mul ha2 hb2,
    have hc3 : ∀ n, c n ∈ s * t := λ n, ⟨a n, b n, ha3 _, hb3 _, rfl⟩,
    refine le_of_tendsto' hc2 (λ n, (real.is_lub_Sup _ hst1 hst2).1 ⟨_, _, ha3 _, hb3 _, rfl⟩), },
  { refine cSup_le hst1 _,
    rintros _ ⟨a, b, ha, hb, rfl⟩,
    have ha1 := (real.is_lub_Sup s hs1 hs2).1 ha,
    have hb1 := (real.is_lub_Sup t ht1 ht2).1 hb,
    refine mul_le_mul ha1 hb1 (ht _ hb) le1, },
end

@[simp] lemma prod_lovasz_number_at [finite V] [finite W] (e : E) (f : F) :
  (ρ.prod ρ').lovasz_number_at (e ⊗ₜ f) = (ρ.lovasz_number_at e) * (ρ'.lovasz_number_at f) :=
begin
  rw [lovasz_number_at],
  simp_rw [prod_to_fun, inner_product_space.inner_tprod,
    norm_eq_sqrt_real_inner, inner_product_space.inner_tprod],
  rw [lovasz_number_at_eq_csupr, lovasz_number_at_eq_csupr],
  change Sup _ = Sup _ * Sup _,
  rw real.Sup_mul_Sup, congr' 1, ext1 x, split,
  { rintros ⟨⟨v, w⟩, rfl⟩, dsimp only,
    simp_rw [←real_inner_self_eq_norm_sq],
    refine ⟨inner e e / (inner (ρ v) e)^2, inner f f / (inner (ρ' w) f)^2, ⟨_, rfl⟩, ⟨_, rfl⟩, _⟩,
    conv_rhs { rw [real_inner_self_eq_norm_sq, real_inner_self_eq_norm_sq] },
    rw [real.sqrt_mul, real.sqrt_sq, real.sqrt_sq, mul_pow, ←real_inner_self_eq_norm_sq,
      ←real_inner_self_eq_norm_sq, mul_pow, mul_div, mul_div_assoc, div_mul, mul_div_assoc],
    field_simp, exact norm_nonneg f, exact norm_nonneg e, exact sq_nonneg _,},
  { rintros ⟨_, _, ⟨v, rfl⟩, ⟨w, rfl⟩, rfl⟩,
    dsimp only, rw [←real_inner_self_eq_norm_sq, ←real_inner_self_eq_norm_sq],
    rw set.mem_range, refine ⟨⟨v, w⟩, _⟩,
    rw [real_inner_self_eq_norm_sq, real_inner_self_eq_norm_sq, real.sqrt_mul, mul_pow,
      real.sqrt_sq, real.sqrt_sq, pow_two, pow_two, pow_two, pow_two, pow_two], dsimp only,
      field_simp, congr' 1, ring1, exact norm_nonneg f, exact norm_nonneg e,
      rw pow_two, exact mul_self_nonneg _ },
  { rintros _ ⟨x, rfl⟩, dsimp only,
    apply div_nonneg; rw pow_two; exact mul_self_nonneg _,  },
  { rintros _ ⟨x, rfl⟩, dsimp only,
    apply div_nonneg; rw pow_two; exact mul_self_nonneg _,  },
end

/-- If `ρ` is an orthogonal representation of a graph `G` in `E`, then
`(x₁, x₂, …, xₖ) ↦ (ρ x₁) ⊗ (ρ x₂) ⊗ ⋯ ⊗ (ρ xₖ)` defines an orthogonal representation of the strong
product `G ⊠ G ⊠ ⋯ ⊠ G` in `E ⊗ E ⊗ ⋯ ⊗ E`. -/
@[simps] def pow (k : ℕ) : orthogonal_representation (⊠^k G) (⨂[ℝ]^k E) :=
{ to_fun := λ x, tensor_power.tpow ℝ (ρ ∘ x),
  norm_eq_one' := λ v, begin
    rw [norm_eq_sqrt_real_inner, real.sqrt_eq_iff_mul_self_eq, one_mul,
      inner_product_space.tensor_power.inner_tpow],
    simp_rw [ρ.inner_self_eq_one, finset.prod_const_one],
    exact real_inner_self_nonneg, norm_num
  end,
  inner_eq_zero_of_ne_of_not_adj' := λ v w neq nadj, begin
    rw [simple_graph.strong_pi_adj, not_and_distrib, not_forall] at nadj,
    simp_rw [not_or_distrib] at nadj,
    rw [inner_product_space.tensor_power.inner_tpow],
    rcases nadj with h|⟨x, ⟨h1, h2⟩⟩,
    { exact false.elim (h neq) },
    { rw [finset.prod_eq_zero_iff],
      exact ⟨x, finset.mem_univ _, ρ.inner_eq_zero_of_ne_of_not_adj h1 h2⟩, },
  end, }

@[simp] def vec_equiv_prod {k : ℕ} : (fin k.succ → V) ≃ (fin k → V) × V :=
{ to_fun := λ v, (λ x, v (fin.succ x), v 0),
  inv_fun := λ p x, if h : (x : ℕ) ≠ 0
    then p.1 ⟨nat.pred x, lt_of_lt_of_le (nat.pred_lt h) (nat.lt_succ_iff.mp x.2)⟩
    else p.2,
  left_inv := λ f, funext $ λ x, begin
    dsimp only, split_ifs,
    { congr' 1, ext1,
      rw [fin.succ_mk, fin.coe_mk, ←nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
      rwa pos_iff_ne_zero, },
    { push_neg at h, congr' 1, ext1, exact h.symm, },
  end,
  right_inv := λ ⟨f, v⟩, begin
    ext1, dsimp only,
    { ext1 x, split_ifs, simp_rw [fin.coe_succ, nat.pred_succ], congr' 1, ext1, refl,
      exfalso, push_neg at h, refine nat.succ_ne_zero x _, convert h,
      rw fin.coe_succ, },
    { dsimp only, rw dif_neg, push_neg, refl, },
  end }

@[simps] def vec_fun_equiv {k : ℕ} : ((fin k.succ → V) → ℝ) ≃ (((fin k → V) × V) → ℝ) :=
{ to_fun := λ f x, f (vec_equiv_prod.symm x),
  inv_fun := λ f x, f (vec_equiv_prod x),
  left_inv := λ f, funext $ λ x, begin
    dsimp only, congr' 1, simp only [equiv.symm_apply_apply],
  end,
  right_inv := λ f, funext $ λ x, begin
    dsimp only, congr' 1, simp only [equiv.apply_symm_apply],
  end }

lemma succ_vec_fun_range {k : ℕ} (f : (fin k.succ → V) → ℝ) :
  set.range f = set.range (vec_fun_equiv f) :=
begin
  ext1 x, split,
  { rintros ⟨v, rfl⟩,
    refine ⟨vec_equiv_prod v, _⟩,
    simp only [vec_equiv_prod, ne.def, dite_not, equiv.coe_fn_mk, vec_fun_equiv_apply,
      equiv.coe_fn_symm_mk, fin.succ_mk],
    congr' 1, ext, split_ifs,
    { congr' 1, ext1, rw h, refl, },
    { congr' 1, ext1, rw [fin.coe_mk, ←nat.succ_eq_add_one, nat.succ_pred_eq_of_pos],
      rw pos_iff_ne_zero, exact h, } },
  { rintros ⟨⟨g, v⟩, rfl⟩,
    simp only [vec_fun_equiv_apply, mem_range_self], },
end

@[simp] lemma pow_lovasz_number_at {k : ℕ} [finite V] (e : fin k → E) :
  (ρ.pow k).lovasz_number_at (tensor_power.tpow ℝ e) = ∏ i, ρ.lovasz_number_at (e i) :=
begin
  rw [lovasz_number_at, supr],
  induction k with k ih,
  { rw [fin.prod_univ_zero],
    have : range (λ (v : fin 0 → V), ∥tensor_power.tpow ℝ e∥ ^ 2 / inner ((ρ.pow 0) v) (tensor_power.tpow ℝ e) ^ 2) = {1},
    { ext, split,
      { rintros ⟨y, rfl⟩, dsimp only,
        rw [pow_to_fun, set.mem_singleton_iff, ←real_inner_self_eq_norm_sq,
          inner_product_space.tensor_power.inner_tpow, fin.prod_univ_zero,
          inner_product_space.tensor_power.inner_tpow, fin.prod_univ_zero, one_pow, div_one] },
      { rintros h, rw set.mem_singleton_iff at h, rw h,
        refine ⟨fin_zero_elim, _⟩, dsimp only,
        rw [←real_inner_self_eq_norm_sq, inner_product_space.tensor_power.inner_tpow,
          fin.prod_univ_zero, pow_to_fun, inner_product_space.tensor_power.inner_tpow,
          fin.prod_univ_zero, one_pow, div_one] }, },
        rw [this, cSup_singleton], },
  { rw [fin.prod_univ_succ, ←ih, succ_vec_fun_range],
    rw [lovasz_number_at, supr, real.Sup_mul_Sup],
    congr' 1,
    { ext1, split,
      { rintros ⟨y, rfl⟩,
        simp only [ne.def, vec_equiv_prod, pow_to_fun, inner_product_space.tensor_power.inner_tpow,
          comp_app, vec_fun_equiv_apply, dite_not, equiv.coe_fn_symm_mk],
        rw [fin.prod_univ_succ, ←real_inner_self_eq_norm_sq, ←real_inner_self_eq_norm_sq,
          inner_product_space.tensor_power.inner_tpow, dif_pos, fin.prod_univ_succ, mul_pow],
        rw show ∀ (a b c d : ℝ), (a * b) / (c * d) = (a / c) * (b / d),
        { intros, ring_nf, rw mul_inv, },
        refine ⟨_, _, ⟨y.2, rfl⟩, ⟨y.1, _⟩, rfl⟩,
        { dsimp only, rw [←real_inner_self_eq_norm_sq, inner_product_space.tensor_power.inner_tpow],
          congr' 2, refine finset.prod_congr rfl _,
          intros x _, rw [dif_neg],
          simp_rw [fin.coe_succ, nat.pred_succ], congr, ext1, refl,
          rw [fin.coe_succ],
          exact nat.succ_ne_zero _, },
        refl },
      { rintros ⟨_, _, ⟨x, rfl⟩, ⟨y, rfl⟩, rfl⟩,
        dsimp only, refine ⟨⟨y, x⟩, _⟩,
        simp only [ne.def, vec_equiv_prod, pow_to_fun, inner_product_space.tensor_power.inner_tpow,
          comp_app, vec_fun_equiv_apply, dite_not, equiv.coe_fn_symm_mk],
        rw [←real_inner_self_eq_norm_sq, ←real_inner_self_eq_norm_sq, ←real_inner_self_eq_norm_sq,
          inner_product_space.tensor_power.inner_tpow, inner_product_space.tensor_power.inner_tpow,
          fin.prod_univ_succ, fin.prod_univ_succ, dif_pos, mul_pow],
        rw show ∀ (a b c d : ℝ), (a * b) / (c * d) = (a / c) * (b / d),
        { intros, ring_nf, rw mul_inv, },
        congr' 3, refine finset.prod_congr rfl _,
        intros x _, rw [dif_neg], simp_rw [fin.coe_succ, ←nat.succ_eq_add_one, nat.pred_succ],
        congr, ext1, refl,
        rw [fin.coe_succ], exact nat.succ_ne_zero _,
        refl, } },
      { rintros _ ⟨v, rfl⟩, dsimp only, rw [←div_pow, pow_two], exact mul_self_nonneg _ },
      { rintros _ ⟨f, rfl⟩, dsimp only, rw [←div_pow, pow_two], exact mul_self_nonneg _ } },
end

lemma pow_lovasz_number_at' {k : ℕ} [finite V] (e : E) :
  (ρ.pow k).lovasz_number_at (tensor_power.tpow ℝ (λ i, e)) = (ρ.lovasz_number_at e)^k :=
by rw [pow_lovasz_number_at, finset.prod_const, finset.card_univ, fintype.card_fin]

end orthogonal_representation

end simple_graph


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import combinatorics.simple_graph.prod
import data.fin.succ_pred
import order.succ_pred.relation

/-!
# The Hasse diagram as a graph

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

This file defines the Hasse diagram of an order (graph of `covby`, the covering relation) and the
path graph on `n` vertices.

## Main declarations

* `simple_graph.hasse`: Hasse diagram of an order.
* `simple_graph.path_graph`: Path graph on `n` vertices.
-/

open order order_dual relation

namespace simple_graph
variables (α β : Type*)

section preorder
variables [preorder α] [preorder β]

/-- The Hasse diagram of an order as a simple graph. The graph of the covering relation. -/
def hasse : simple_graph α :=
{ adj := λ a b, a ⋖ b ∨ b ⋖ a,
  symm := λ a b, or.symm,
  loopless := λ a h, h.elim (irrefl _) (irrefl _) }

variables {α β} {a b : α}

@[simp] lemma hasse_adj : (hasse α).adj a b ↔ a ⋖ b ∨ b ⋖ a := iff.rfl

/-- `αᵒᵈ` and `α` have the same Hasse diagram. -/
def hasse_dual_iso : hasse αᵒᵈ ≃g hasse α :=
{ map_rel_iff' := λ a b, by simp [or_comm],
  ..of_dual }

@[simp] lemma hasse_dual_iso_apply (a : αᵒᵈ) : hasse_dual_iso a = of_dual a := rfl
@[simp] lemma hasse_dual_iso_symm_apply (a : α) : hasse_dual_iso.symm a = to_dual a := rfl

end preorder

section partial_order
variables [partial_order α] [partial_order β]

@[simp] lemma hasse_prod : hasse (α × β) = hasse α □ hasse β :=
by { ext x y, simp_rw [box_prod_adj, hasse_adj, prod.covby_iff, or_and_distrib_right,
  @eq_comm _ y.1, @eq_comm _ y.2, or_or_or_comm] }

end partial_order

section linear_order
variables [linear_order α]

lemma hasse_preconnected_of_succ [succ_order α] [is_succ_archimedean α] : (hasse α).preconnected :=
λ a b, begin
  rw reachable_iff_refl_trans_gen,
  exact refl_trans_gen_of_succ _ (λ c hc, or.inl $ covby_succ_of_not_is_max hc.2.not_is_max)
    (λ c hc, or.inr $ covby_succ_of_not_is_max hc.2.not_is_max),
end

lemma hasse_preconnected_of_pred [pred_order α] [is_pred_archimedean α] : (hasse α).preconnected :=
λ a b, begin
  rw [reachable_iff_refl_trans_gen, ←refl_trans_gen_swap],
  exact refl_trans_gen_of_pred _ (λ c hc, or.inl $ pred_covby_of_not_is_min hc.1.not_is_min)
    (λ c hc, or.inr $ pred_covby_of_not_is_min hc.1.not_is_min),
end

end linear_order

/-- The path graph on `n` vertices. -/
def path_graph (n : ℕ) : simple_graph (fin n) := hasse _

lemma path_graph_preconnected (n : ℕ) : (path_graph n).preconnected := hasse_preconnected_of_succ _
lemma path_graph_connected (n : ℕ) : (path_graph (n + 1)).connected := ⟨path_graph_preconnected _⟩

end simple_graph


/-
M1F 2017-18 Sheet 1 Question 1
Author : Kevin Buzzard

This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/

-/
-- We probably need the "law of the excluded middle" for this question -- every
-- proposition is either true or false! Don't even ask me to explain what the
-- other options are, but Lean does not come with this axiom by default (blame
-- the computer scientists) and mathematicians have to add it themselves.
-- It's easy to add though. "em" for excluded middle.

axiom em (X : Prop) : X ∨ ¬ X

variables P Q R S : Prop -- A "Prop" is a proposition, that is, a true/false statement.

-- Sheet 1 Q4. **Edit the question** until it corresponds to what you think the
-- answer is, and then prove it.
-- For example if you think that the answer is that either P and Q are both true
-- or P,Q,R are all false, then change the end of the question (after the iff) to
-- ((P ∧ Q) ∨ (¬ P ∧ ¬ Q ∧ ¬ R))

theorem m1f_sheet01_q04 : (P → (Q ∨ R)) ∧ (¬ Q → (R ∨ ¬ P)) ∧ ((Q ∧ R) → ¬ P) ↔ ((P ∧ Q ∧ R) ∨ (P ∧ ¬ Q ∧ ¬ R)) := sorry