import tactic
import data.real.basic
import data.set

------------
-- ESSAIS --
------------
open set

-----------
-- DEBUT --
-----------

/-- Une structure d'espace métrique sur un type X -/
class espace_metrique (X : Type) :=
(dist : X → X → ℝ)
(dist_pos : ∀ x y, dist x y ≥ 0)
(sep : ∀ x y, dist x y = 0 ↔ x = y)
(sym : ∀ x y, dist x y = dist y x)
(triangle : ∀ x y z, dist x z ≤ dist x y + dist y z)

open espace_metrique

/-- Fonction distance avec le type en argument explicite -/
def dist' (X : Type) [espace_metrique X] : X → X → ℝ := λ x y, dist x y

notation `d` := dist
notation `d_[` X `]` := dist' X

----------------------------------------------------
section fondements
----------------------------------------------------

variables {X : Type} [espace_metrique X]

@[simp]
lemma dist_sym (x:X) (y:X) : d x y = d y x := sym x y

@[simp]
lemma dist_x_x_eq_zero  (x:X) : d x x = 0 :=
 (sep x x).2 rfl

lemma dist_str_pos  {x:X} {y:X} : x ≠ y → d x y > 0 :=
begin
contrapose!,
intro d_neg,
have d_pos : d x y ≥ 0, from dist_pos x y,
have d_zero : d x y = 0, from antisymm d_neg d_pos,
exact iff.mp (sep x y) d_zero
end

/-- `boule x r` est la boule ouverte de centre `x` et de rayon `r` -/
def boule (x : X) (r : ℝ)  := {y | dist x y < r}

/-- appartenir à une boule équivaut à une inégalité -/
@[simp]
lemma mem_boule (x : X) (r : ℝ) (y : X) : y ∈ boule x r ↔ dist x y < r :=
iff.rfl

/-- Une boule de rayon >0 contient son centre --/
lemma centre_mem_boule (x : X) (r : ℝ) : r > 0 → x ∈ boule x r :=
begin
intro r_pos,
simpa [boule] -- simplifie et utilise l'hypothèse
end

/-- Une partie d'un espace métrique `X` est ouverte si elle contient une boule ouverte de rayon
strictement positif autour de chacun de ses points. -/
def ouvert (A : set X) := ∀ x ∈ A, ∃ r > 0, boule x r ⊆ A

/-- Les boules sont ouvertes -/
lemma boule_est_ouverte : ∀ x : X, ∀ r > 0, ouvert (boule x r) :=
begin
  intros x r r_pos y y_in, -- on déroule les définitions,
  -- on se retrouve avec un point y dans la boule
  -- de centre x et de rayon r, et on cherche une boule autour de y qui soit incluse
  -- dans boule x r
  set ε := r - d x y with hε,
  use  ε, -- le rayon candidat
  -- OBSOLETE rw exists_prop,
  split,
  { -- La ligne suivante peut être remplacée par n'importe laquelle des trois lignes qui la suivent
    simp [boule] at y_in,
    --change d x y < r at y_in,
    --rw mem_boule at y_in,
    --unfold boule at y_in, rw set.mem_set_of_eq at y_in,
    linarith only [hε, y_in]}, -- le rayon est bien strictement positif
  { -- La ligne suivante est optionnelle, elle sert  à expliciter le but
    -- change ∀ z, z ∈ boule y (r - d x y) → z ∈ boule x r,
    intros z z_in,
    rw mem_boule at *,
    have clef : d x z ≤ d x y + d y z, from triangle x y z,
    linarith only [clef, z_in, y_in, hε]} -- et l'inégalité triangulaire permet de montrer l'inclusion des boules
end

-- Lemme de théorie des ensembles - finalement non utilisé
lemma inclusion_transitive {Y : Type} {A B C : set Y} : A ⊆ B → B ⊆ C → A ⊆ C :=
begin
  intros AB BC a a_app_A,
  exact BC (AB a_app_A),
end

/-- Une union d'ouverts d'un espace métrique est un ouvert -/
lemma union_ouverts_est_ouvert (I : set (set X)) : (∀ O ∈ I, ouvert O) → ouvert (⋃₀ I) :=
begin
  -- Supposons que tous les O dans I sont ouverts.
  intro O_ouverts,
  -- Soit x un point d'un des O dans I
  rintro x ⟨O, O_app_I, x_app_O⟩,
  -- Comme O est ouvert, il existe r > 0 tel que B(x, r) ⊆ O
  obtain ⟨r, r_positif, boule_dans_O⟩ : ∃ r > 0, boule x r ⊆ O,
    from (O_ouverts O) O_app_I x x_app_O,
  -- Montrons que ce r convient
  use [r, r_positif],
  -- Puisque  B(x, r) ⊆ O, il suffit de montrer que O ⊆ ⋃₀ I
  transitivity O, assumption,
  -- Or O est dans I.
  exact subset_sUnion_of_mem O_app_I
end

-- ** variante en λ-calcul - non utilisé
lemma union_ouverts_est_ouvert' (I : set (set X)) : (∀ O ∈ I, ouvert O) → ouvert (⋃₀ I) :=
assume O_ouverts x ⟨O, O_app_I, x_app_O⟩,
let ⟨r, r_positif, boule_dans_O⟩ := O_ouverts O O_app_I x x_app_O in
⟨r, r_positif, subset.trans boule_dans_O (subset_sUnion_of_mem O_app_I)⟩

/-- L'intersection de deux ouverts est un ouvert -/
lemma intersection_deux_ouverts_est_ouvert : ∀ O₁ O₂ : set X, ouvert O₁ →  ouvert O₂ → ouvert (O₁ ∩ O₂) :=
begin
  -- Soit x un point dans l'intersection,
  rintro O₁ O₂ ouvert_O₁ ouvert_O₂ x ⟨x_app_O₁,x_app_O₂⟩,
  -- le fait que O₁ et O₂ soient ouverts fournis deux nombres positifs
  obtain ⟨r₁,r₁_pos,boule_dans_O₁⟩ : ∃ r₁>0, boule x r₁ ⊆ O₁, from ouvert_O₁ x x_app_O₁,
  obtain ⟨r₂,r₂_pos,boule_dans_O₂⟩ : ∃ r₂>0, boule x r₂ ⊆ O₂, from ouvert_O₂ x x_app_O₂,
  -- Montrons que le minimum r des deux convient
  use min r₁ r₂,
  -- OBSOLETE rw exists_prop,
  -- Il est bien positif
  split,
    by exact lt_min r₁_pos r₂_pos,
  -- les quatre lignes qui précèdent peuvent être remplacées par :
  -- use [min r₁ r₂,lt_min r₁_pos r₂_pos]

  -- Prenons un y dans la boule de rayon r
  intros y y_app_boule,
  -- vu le choix de r, on a d x y < r₁ et d x y < r₂
  simp [boule] at y_app_boule,
  -- donc c'est bon
  split  ; tautology
  -- FIN plus compliquée :
  -- simp [boule] at y_app_boule,
  -- rcases y_app_boule with ⟨ineg_1,ineg_2⟩,
  -- -- il est dans O₁ et dans O₂
  -- have y_O₁ : y ∈ O₁, from boule_dans_O₁ ineg_1,
  -- have y_O₂ : y ∈ O₂, from boule_dans_O₂ ineg_2,
  -- -- donc dans l'intersection, comme voulu.
  -- exact and.intro y_O₁ y_O₂,
end

/-- L'espace total est ouvert -/
lemma total_ouvert : ouvert (univ : set X) :=
begin
  intros x hx,
  use 1,
  -- OBSOLETE rw exists_prop,
  split,
    exact zero_lt_one,
    exact subset_univ (boule x 1),
end

/-- L'intersection d'un nombre fini d'ouverts est un ouvert -/
--lemma intersection_ouverts_est_ouvert'
--(I : set (set X)) : (finite I) (∀ O ∈ I, ouvert O) → ouvert (⋂₀ I) :=
--begin
  --tactic.unfreeze_local_instances,
  --rcases _inst_2 with ⟨Liste, Liste_exhaustive⟩,
  --sorry
--end

--{s : set β} {f : β → set α} (hs : finite s) :
--variables (β : Type)
--lemma intersection_ouverts_est_ouvert  {s: set β} {O : β → set X} (hs: finite s) :
--  (∀ i, ouvert (O i)) → ouvert (⋂ i, O i) :=
--begin
--  set.finite.induction_on hs (sorry) (sorry)
  -- (λ _, by rw bInter_empty; exact total_ouvert)
  -- (λ a s has hs ih h, by rw bInter_insert; exact
    -- is_open_inter (h a (mem_insert _ _)) (ih (λ i hi, h i (mem_insert_of_mem _ hi))))
--end

--lemma is_open_sInter {s : set (set X)} (hs : finite s) : (∀t ∈ s, ouvert t) → ouvert (⋂₀ s) :=

lemma vide_ouvert : ouvert (∅ : set X) :=
begin
  intros x x_in,
  exfalso,
  exact x_in,
end

lemma vide_ouvert' : ouvert (∅ : set X) :=
assume x x_in, false.elim x_in

/-- L'intérieur d'une partie de X est la réunion des ouverts qu'elle contient -/
def Int (E : set X) := ⋃₀ {O : set X | ouvert O ∧ O ⊆ E}

/-- Caractérisation métrique de l'intérieur -/
@[simp]
lemma interieur_metrique {E : set X} {x : X} : x ∈ Int E ↔  ∃ r>0, boule x r ⊆ E  :=
begin
split,
  -- Pour le sens direct, supposons que x est dans l'intérieur de E
  intro x_dans_Int,
    -- Par définition de l'intérieur, il existe un ouvert O inclus dans E et contenant x
  rcases x_dans_Int with ⟨O, ⟨ouvert_O,O_sub_E⟩ , x_app_O⟩,
  -- L'ouvert O contient une boule autour de x
  obtain ⟨r,r_pos,boule_dans_O⟩ : ∃ r>0, boule x r ⊆ O, from ouvert_O x x_app_O,
  -- Cette boule convient
  use [r, r_pos],
  -- puisqu'elle est incluse dans O qui est inclus dans E
  transitivity O, assumption, assumption,
  -- VARIANTE : exact subset.trans boule_dans_O O_sub_E, -- On peut aussi écrire : tauto,
  -- Pour l'autre sens, soit x le centre d'une boule incluse dans E.
rintros ⟨ r,r_pos, boule_dans_E⟩,
  -- Cette boule est un ouvert
  have ouvert_boule, from boule_est_ouverte x r r_pos,
  -- et elle contient x
  have x_mem_boule, from centre_mem_boule x r r_pos,
  -- donc x est dans l'intérieur de E
  use boule x r,
  repeat { split }, assumption, assumption, assumption,
  -- VARIANTE FIN PLUS COMPLIQUEE : -- la boule est donc incluse dans l'intérieur de E
  -- let I := {O : set X | ouvert O ∧ O ⊆ E},
  -- have boule_mem_I : (boule x r) ∈ I,
  --   exact and.intro ouvert_boule boule_dans_E,
  -- have boule_inc_Int : boule x r ⊆ Int E, from subset_sUnion_of_mem boule_mem_I,
  -- -- qui contient donc x, centre d'une boule incluse dans Int E
  -- exact boule_inc_Int (centre_mem_boule x r r_pos),
end

-- Variante moins pratique (?)
lemma interieur_metrique' {E : set X} : Int E = { x : X | ∃ r>0, boule x r ⊆ E } :=
begin
  -- Nous raisonnons par double inclusion
  apply subset.antisymm,
  -- Soit x dans l'intérieur de E
  intros x x_dans_Int, simp,
  -- Par définition de l'intérieur, il existe un ouvert O inclus dans E et contenant x
  rcases x_dans_Int with ⟨O, ⟨ouvert_O,O_sub_E⟩ , x_app_O⟩,
  -- L'ouvert O contient une boule autour de x
  obtain ⟨r,r_pos,boule_dans_O⟩ : ∃ r>0, boule x r ⊆ O, from ouvert_O x x_app_O,
  -- Cette boule convient
  use [r, r_pos],
  -- puisqu'elle est incluse dans O qui est inclus dans E
  transitivity O, assumption, assumption,
  -- VARIANTE : exact subset.trans boule_dans_O O_sub_E, -- On peut aussi écrire : tauto,
  -- Pour l'autre sens, soit x le centre d'une boule incluse dans E.
  rintros x ⟨ r,r_pos, boule_dans_E⟩,
  -- Cette boule est un ouvert
  have ouvert_boule, from boule_est_ouverte x r r_pos,
  -- et elle contient x
  have x_mem_boule, from centre_mem_boule x r r_pos,
  -- donc x est dans l'intérieur de E
  use boule x r,
  repeat { split }, assumption, assumption, assumption,
  -- VARIANTE FIN PLUS COMPLIQUEE : -- la boule est donc incluse dans l'intérieur de E
  -- let I := {O : set X | ouvert O ∧ O ⊆ E},
  -- have boule_mem_I : (boule x r) ∈ I,
  --   exact and.intro ouvert_boule boule_dans_E,
  -- have boule_inc_Int : boule x r ⊆ Int E, from subset_sUnion_of_mem boule_mem_I,
  -- -- qui contient donc x, centre d'une boule incluse dans Int E
  -- exact boule_inc_Int (centre_mem_boule x r r_pos),
end

def est_voisinage (V : set X) (x : X) := x ∈ Int V

-- caractérisation d'un voisinage en termes d'ouverts ?
-- caractérisation en terme de boules ?

end fondements

----------------------------------------------------
section continuite
----------------------------------------------------
variables {X Y : Type} [espace_metrique X] [espace_metrique Y]

-- dans la définition suivante les `d_[X]` et `d_[Y]` sont cosmétiques, `d` seul marche aussi bien

def continue_en (f : X → Y) (x₀ : X) :=
  ∀ ε > 0, ∃ δ > 0, ∀ x, d_[X] x₀ x < δ → d_[Y] (f x₀) (f x) < ε

def continue (f:X → Y) :=
∀ x : X, continue_en f x

-- Notations f continue, f continue_au_point x

-- caractérisation topologique (ponctuelle, globale)
lemma continuite_ouverts (f:X → Y): continue f ↔ ( ∀O, ouvert O → ouvert (f ⁻¹' O) ) :=
begin
  -- On raisonne par double implication
  split,
  { -- Supposons donc que f vérifie la définition métrique de la continuité
    -- Soit O un ouvert à l'arrivé, il s'agit de voir que son image réciproque est ouverte
    --  SOit x un point de l'image réciproque, on cherche un rayon
    intros cont O O_ouvert x x_dans_reciproque,
    -- c'est-à-dire tel que f(x) ∈ O
    change f x ∈ O at x_dans_reciproque, -- Cette ligne est purement psychologique, on peut la retirer
    -- Puisque O est ouvert, il contient une boule de rayon ε autour de f(x)
    obtain ⟨ε, ε_positif, boule_dans_O⟩ : ∃ ε > 0, boule (f x) ε ⊆ O,
    from O_ouvert (f x) x_dans_reciproque,
    -- L'hypothèse de continuité fournit un δ >0
    rcases (cont x) ε ε_positif with ⟨δ , δ_positif, H⟩,
    -- Montrons que la boule de rayon δ est dans l'image réciproque
    use [δ, δ_positif],
    -- pour ceci on prend un point x' dans la boule
    intros x' hx',
    -- il s'agit de voir que son image est dans O
    change f x' ∈ O, -- encore une ligne purement psychologique, Lean n'en a pas besoin
    -- Pour cela il suffit de voir que f(x') est dans la boule de centre f(x) et de rayon ε,
    -- puisqu'elle est incluse dans O
    suffices hh : f x' ∈ boule (f x) ε, from boule_dans_O hh,
    -- ce qui est donné par la propriété de δ issue de la continuité
    exact H x' hx'
     },
  { -- Pour l'autre direction, on suppose que l'image réciproque de tout ouvert est un ouvert,
    -- on prend un point x et un ε > 0
    rintros H x ε ε_positif,
    -- La boule de centre x et de rayon epsilon est un ouvert de Y,
    have boule_ouverte, from boule_est_ouverte (f x) ε ε_positif,
    -- donc par hypothèse son image réciproque est un ouvert de X
    have reciproque_ouvert, from H (boule (f x) ε) boule_ouverte,
      -- or x appartient à cette image réciproque
    have x_dans_reciproque: x ∈ f ⁻¹' boule (f x) ε,
      simpa [boule],
    -- Il existe donc une boule autour de x incluse dans l'image réciproque de la première boule
    obtain ⟨δ, δ_positif, H⟩: ∃ δ >0, boule x δ ⊆ f ⁻¹' boule (f x) ε ,  from reciproque_ouvert x x_dans_reciproque,
    -- montrons que le rayon de cette boule satisfait la définition métrique de la continuité
    use [δ , δ_positif],
    -- On considère donc un point x' tel que d(x,x') < δ
    intros x' hx',
    -- Autrement dit, x' est dans la boule B(x,δ),
    change x' ∈ boule x δ at hx', -- encore une ligne pour rien
    -- donc son image est dans la première boule
    exact H hx' }
end

variables {Z : Type} [espace_metrique Z]

/-- La composée de deux applications continues est continue-/
lemma composition_continue (f : X → Y) (g : Y → Z) : (continue f) →  (continue g) →  continue (g ∘ f) :=
begin
-- Supposons que f et g sont continues
intros f_cont g_cont,
-- Nous allons utiliser la caractérisation topologique pour montrer la continuité de g ∘ f :
rw continuite_ouverts,
-- On considère un ouvert O de Z
intros O O_ouvert,
-- La caractérisation topologique de la continuité de g nous dit que g ⁻¹' O est un ouvert de Y,
have ouvert1 : ouvert (g ⁻¹' O),
  from (((iff.elim_left (continuite_ouverts g)) g_cont) O) O_ouvert,
-- La caractérisation topologique de la continuité de f nous dit que f ⁻¹' (g ⁻¹' O) est un ouvert de X,
exact (((iff.elim_left (continuite_ouverts f)) f_cont) (g ⁻¹' O)) ouvert1,
-- et il est égal à (g ∘ f)  ⁻¹' O, CQFD
end

-- A FAIRE : caractérisation topologique de la continuité ponctuelle par les voisinages,
-- et composition ponctuelle

def lipschitzienne (k:ℝ) (f: X → Y) :=
∀ x₀  x₁ , d_[Y] (f x₀) (f x₁) ≤ ( k * d_[X] x₀  x₁ )

-- A FAIRE : lipschitzien implique continu

end continuite

----------------------------------------------------
section fermes
----------------------------------------------------
variables {X:Type} [espace_metrique X]

def ferme (F : set X) := ouvert (- F)

-- A FAIRE : intersection, union

/-- L'adhérence d'une partie de X est l'intersection des fermés qui la contienne -/
def Adh (E : set X) := sInter {F : set X | ferme F ∧ E ⊆ F}

-- adhérence et intérieur par passage au complémentaire

/-- Caractérisation métrique de l'adhérence -/

@[simp]
lemma adherence_metrique {E : set X} {x : X} : x ∈ Adh E  ↔ ∀ r>0, boule x r ∩ E ≠ ∅ :=
begin
  sorry
end

end fermes

----------------------------------------------------
section suites
----------------------------------------------------
variables {X:Type} [espace_metrique X]
-- variable E : set X
-- variable x : E
-- #print x

def limite_suite (x: ℕ → X) (l : X) := ∀ ε > 0, ∃ N, ∀ n ≥ N, ((d l (x n))  < ε)

-- On va voir besoin de "0<2" dans ℝ
lemma zero_pp_2 :  (0:real) < 2 :=
begin
linarith only [zero_lt_one]
end

#print zero_pp_2 -- Waou !

open classical
local attribute [instance] prop_decidable
lemma unicite_limite {x: ℕ → X} {l₁ : X} {l₂ : X} :
  (limite_suite x l₁) → (limite_suite x l₂) → l₁ = l₂ :=
begin
-- Supposons que la suite (x_n) converge à la fois vers l₁ et l₂
intros H₁ H₂,
-- Raisonnons par l'absurde, en supposant l₁ ≠ l₂
by_contradiction lim_non_eg,
-- Alors d(l₁, l₂) >0
have dist_limites_pos : 0 < d l₁ l₂, from dist_str_pos lim_non_eg,
-- Appelons ε la moitié de cette distance, qui est donc aussi un nombre positif
let ε := (d l₁ l₂)/2,
have ε_pos : 0 < ε, from  div_pos dist_limites_pos zero_pp_2,
-- et appliquons la définition de convergence à nos deux limites
rcases H₁ ε ε_pos with ⟨ N₁ , HN₁ ⟩,
rcases H₂ ε ε_pos with ⟨ N₂ , HN₂ ⟩,
-- On obtient deux rangs N₁, N₂, dont on prend le maximum
let N := max N₁ N₂,
-- La définition de convergence nous donne les deux inégalités d(l₁,x_N )< ε et  d(l₂,x_N) < ε
have I₁ : d l₁ (x N) < ε, from  HN₁ N (le_max_left N₁ N₂),
have I₂ : d l₂ (x N) < ε, from  HN₂ N (le_max_right N₁ N₂),
-- En les combinant à l'inégalité triangulaire entre les trois points impliqué,
-- on obtient d(l₁,l₂) <  d(l₁,l₂),
have egal : d l₁ l₂  = 2 * ε , from eq.symm (@mul_div_cancel' ℝ real.field (d l₁ l₂) 2 two_ne_zero),
have Ineg : d l₁ l₂ < d l₁ l₂, from
calc
   d l₁ l₂ ≤ d l₁ (x N) + d (x N) l₂  : (triangle l₁ (x N) l₂)
    ...    ≤ d l₁ (x N) + d l₂ (x N)  : by simp
    -- Linarith se débrouille sans les 3 lignes suivante :
    -- ...    < ε + ε                    : by linarith
    -- ...    = 2 * ε                    : eq.symm (two_mul ε)
    -- ...    = d l₁ l₂                  : by rw egal,
      ...   < d l₁ l₂                  : by linarith,
-- ce qui donne la contradiction recherchée.
linarith only [Ineg]
end

-- nom des lemmes trouvés avec la tactique library_search
example (ε : ℝ) : 2*ε = ε + ε := two_mul ε
example (a : ℝ) (b : ℝ) (h₁ : 0 < a) (h₂ : 0 < b) : 0 < a/b := div_pos h₁ h₂
example (a : ℝ) (b : ℝ) (H : a ≠ 0) : a * (b/a) = b := mul_div_cancel' b H
example (a : ℝ) (b : ℝ) (h₁ : a = b) : b = a := eq.symm h₁
example (a : ℝ) (h₁ : a < a) : false := by linarith
example : @has_lt.lt real real.has_lt 0 1 := zero_lt_one

-- Variante utilisant le lemme suivant :
lemma pp_que_tout_pos (l : real) : (∀ ε>0, l ≤ ε)  → l ≤ 0 :=
begin
  contrapose!,
  intro H,
  use l/2,
  split,
  linarith,
  linarith
end

lemma unicite_limite' {x: ℕ → X} {l₁ : X} {l₂ : X} :
  (limite_suite x l₁) → (limite_suite x l₂) → l₁ = l₂ :=
begin
  intros H1 H2,
  have H : (∀ ε>0, d l₁ l₂ ≤ ε),
      intros ε ε_pos,
      have εs2_pos : ε/2>0, by linarith,
      have H1', from H1 _ εs2_pos,
      cases H1' with N₁ PN₁ ,
      have H2', from H2 _ εs2_pos,
      cases H2' with N₂ PN₂,
      have HN₁  : max N₁ N₂ ≥ N₁ , by exact le_max_left N₁ N₂, -- library_search
      have HN₂  : max N₁ N₂ ≥ N₂ , by exact le_max_right N₁ N₂, -- library_search
      specialize PN₁  _ HN₁ ,
      specialize PN₂  _ HN₂ ,
      have T, from triangle l₁ (x (max N₁ N₂)) l₂,
      have Dsym, from sym l₂ (x (max N₁ N₂)),
      exact calc
        d l₁ l₂ ≤ d l₁ (x (max N₁ N₂)) + d (x (max N₁ N₂)) l₂ : T
          ...   ≤ ε : by linarith,
  have D , from  pp_que_tout_pos (d l₁ l₂) H,   -- : (d l₁ l₂) ≤ 0
  have D' , from dist_pos l₁ l₂,
  have D'' , by exact le_antisymm D D', -- d l₁ l₂ =0
  exact (sep l₁ l₂).1 D''
end

lemma nonvide_ssi_existe_element (A : set X) : A ≠ ∅ ↔ ∃ a : X, a ∈ A :=
ne_empty_iff_nonempty

lemma essai (a : ℝ) (b : ℝ) (c : ℝ) (H1 : a > b) (H2 : b > c) : a > c :=
begin
  transitivity b, exact H1, exact H2,
end

lemma inv_inv2 {ε : ℝ} (ε_nz : ε ≠ 0) : ε = 1 / (1 / ε) :=
begin
  have inv_ε_nz : (1/ε) ≠ 0, from one_div_ne_zero ε_nz,
  have H : ε * (1/ε) = 1, from mul_div_cancel' 1 ε_nz,
  exact (eq_div_iff_mul_eq ε 1 inv_ε_nz).2 H,
end

-- critère séquentiel d'adhérence (construire une suite)
lemma critere_sequentiel_adherence (E : set X) (l : X) :
          l ∈ Adh E ↔ ∃ x : ℕ → X, (∀ n, x n ∈ E) ∧ (limite_suite x l) :=
begin
split,
  -- Pour le sens direct, on prend l dans l'adhérence de E
  -- et on cherche à construire une suite d'éléments de E qui converge vers l
  intros Hl,
    -- Comment éviter d'avoir à introduire cette grosse propriété intermédiaire ?
  have H1 : ∀ n : ℕ, ∃ x : X, d l x < 1/(n+1) ∧ x ∈ E,
    intro n,
    -- have H2, from H 1/(n+1),
    -- exact adherence_metrique.mpr l Hl,
    sorry,
  -- H1 permet de définir une suite (x_n) qui va convenir
  choose x H using H1,
  use x,
  split,
    -- La suite est bien à valeur dans E,
    exact λ n, ((H n).2),
  -- Reste à montrer qu'elle converge vers l
    intros ε ε_pos,
    have HN, from exists_nat_gt (1 / ε),
    cases HN with N HN,
    use N, intros n Hn,
    specialize H n,
    cases H with Hutile Hinutile,
    have Ineg : N < n+1, by linarith,
    have Ineg2 : ↑n+(1:ℝ)  > ↑N, by exact_mod_cast Ineg,
    have Ineg3 : ↑n+1 > 1/ε,
      begin
        transitivity ↑N,
        exact Ineg2,
        exact HN,
      end,
    have inv_ε_pos : (1/ε)>0, from one_div_pos_of_pos ε_pos,
    have Ineg4, by exact one_div_lt_one_div_of_lt inv_ε_pos Ineg3,
    transitivity 1 / (↑n + 1:ℝ),
      exact Hutile,
    have NZ : ε ≠ 0, by linarith,
    -- have inv_inv_ε : ε = 1/(1/ε), by inv_inv2 NZ,

    sorry,
  -- Pour l'autre direction, on suppose l'existence d'une suite
  -- d'éléments de E convergeant vers l
rintro ⟨x,H1,H2⟩,
-- On utilise la caractérisation métrique de l'adhérence
rw adherence_metrique,
rintro r Hr,
rw limite_suite at H2,
have H, from (H2 r) Hr,
-- obtain ⟨N, H3N⟩ : ℕ  ,(∀ (n : ℕ), n ≥ N → d l (x n) < r) , from (H2 r) Hr,
cases H with N HN,
have HNN: N ≥ N, by linarith,
specialize HN N HNN,
rw← mem_boule at HN,
specialize H1 N,
rw ne_empty_iff_nonempty,
use x N,
exact and.intro HN H1
end

example  (a : ℝ) (b : ℝ) (a_pos : a>0) (a_inf_b : a <b) : 1/a > 1/b :=
begin
  exact one_div_lt_one_div_of_lt a_pos a_inf_b
end

example (x : ℝ) (H : x ≠ 0) : x * (1/x) = 1 := mul_div_cancel' 1 H
example (x : ℝ) (y : ℝ) (H : x ≠ 0) : ( y = 1/x ) ↔ ( y * x = 1 ) :=
        eq_div_iff_mul_eq y 1 H

-- critère séquentiel de fermeture

-- critère séquentiel de continuité

end suites

----------------------------------------------------
section sous_espaces_metriques
----------------------------------------------------

----------------------------------------------------
section distances_equivalentes
----------------------------------------------------

----------------------------------------------------
section espaces_metriques_produits
----------------------------------------------------

----------------------------------------------------
section espaces_de_fonctions
----------------------------------------------------


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

! This file was ported from Lean 3 source module number_theory.class_number.admissible_abs
! leanprover-community/mathlib commit e97cf15cd1aec9bd5c193b2ffac5a6dc9118912b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Basic
import Mathlib.NumberTheory.ClassNumber.AdmissibleAbsoluteValue

/-!
# Admissible absolute value on the integers
This file defines an admissible absolute value `AbsoluteValue.absIsAdmissible`
which we use to show the class number of the ring of integers of a number field
is finite.

## Main results

 * `AbsoluteValue.absIsAdmissible` shows the "standard" absolute value on `ℤ`,
   mapping negative `x` to `-x`, is admissible.
-/

namespace AbsoluteValue

open Int

/-- We can partition a finite family into `partition_card ε` sets, such that the remainders
in each set are close together. -/
theorem exists_partition_int (n : ℕ) {ε : ℝ} (hε : 0 < ε) {b : ℤ} (hb : b ≠ 0) (A : Fin n → ℤ) :
    ∃ t : Fin n → Fin ⌈1 / ε⌉₊, ∀ i₀ i₁, t i₀ = t i₁ → ↑(abs (A i₁ % b - A i₀ % b)) < abs b • ε :=
  by
  have hb' : (0 : ℝ) < ↑(abs b) := Int.cast_pos.mpr (abs_pos.mpr hb)
  have hbε : 0 < abs b • ε := by
    rw [Algebra.smul_def]
    exact mul_pos hb' hε
  have hfloor : ∀ i, 0 ≤ floor ((A i % b : ℤ) / abs b • ε : ℝ) :=
    fun _ ↦ floor_nonneg.mpr (div_nonneg (cast_nonneg.mpr (emod_nonneg _ hb)) hbε.le)
  refine' ⟨fun i ↦ ⟨natAbs (floor ((A i % b : ℤ) / abs b • ε : ℝ)), _⟩, _⟩
  · rw [← ofNat_lt, natAbs_of_nonneg (hfloor i), floor_lt]
    apply lt_of_lt_of_le _ (Nat.le_ceil _)
    rw [Algebra.smul_def, eq_intCast, ← div_div, div_lt_div_right hε, div_lt_iff hb', one_mul,
      cast_lt]
    exact Int.emod_lt _ hb
  intro i₀ i₁ hi
  have hi : (⌊↑(A i₀ % b) / abs b • ε⌋.natAbs : ℤ) = ⌊↑(A i₁ % b) / abs b • ε⌋.natAbs :=
    congr_arg ((↑) : ℕ → ℤ) (Fin.mk_eq_mk.mp hi)
  rw [natAbs_of_nonneg (hfloor i₀), natAbs_of_nonneg (hfloor i₁)] at hi
  have hi := abs_sub_lt_one_of_floor_eq_floor hi
  rw [abs_sub_comm, ← sub_div, abs_div, abs_of_nonneg hbε.le, div_lt_iff hbε, one_mul] at hi
  rwa [Int.cast_abs, Int.cast_sub]
#align absolute_value.exists_partition_int AbsoluteValue.exists_partition_int

/-- `abs : ℤ → ℤ` is an admissible absolute value. -/
noncomputable def absIsAdmissible : IsAdmissible AbsoluteValue.abs :=
  { AbsoluteValue.abs_isEuclidean with
    card := fun ε ↦ ⌈1 / ε⌉₊
    exists_partition' := fun n _ hε _ hb ↦ exists_partition_int n hε hb }
#align absolute_value.abs_is_admissible AbsoluteValue.absIsAdmissible

noncomputable instance : Inhabited (IsAdmissible AbsoluteValue.abs) :=
  ⟨absIsAdmissible⟩

end AbsoluteValue


import data.real.basic

theorem SW_15_induction (x:ℝ) (k:ℕ) (h0: 0 ≤ x) (h1: x ≤ 1):
  1 - (k:ℝ) * x ≤ (1 - x)^k := nat.rec_on k ( -- Base for induction
    calc 1 - ↑0 * x = 1 - 0*x: by rw nat.cast_zero
                ... = 1 - 0: by rw zero_mul
                ... = 1: by ring
                ... ≤ 1: le_refl 1
                ... = (1-x)^0: pow_zero (1-x)
  ) ( -- Inductive step 1 - ↑(nat.succ n) * x ≤ (1 - x) ^ nat.succ n
    λ n, λ h,
    have H:   0 ≤ 1-x, from le_sub.mp (calc
              x ≤ 1: h1
            ... = 1-0: by ring),
    have hkk:(1-x)≤ 1, from by {simp,exact h0,},
    have hn: (1-x)^n ≤ 1, from calc
             (1-x)^n ≤ 1^n : pow_le_pow_of_le_left H hkk n
                 ... = 1   : one_pow n,
    have hm: -(1*x) ≤ (-(1-x)^n)*x, from calc
             -(1*x) ≤ -((1-x)^n*x): neg_le_neg (mul_le_mul_of_nonneg_right hn h0)
                ... = (-(1-x)^n)*x: by ring,
    calc  1 - ↑(nat.succ n) * x
        = 1 - ↑ (n+1) * x  : by rw nat.succ_eq_add_one
    ... = 1 - (↑n + ↑1) * x         : by norm_cast
    ... = 1 - (↑n * x + ↑1*x)       : by rw right_distrib (↑ n) (↑ 1) x
    ... = 1 - (↑n * x + 1*x)        : by norm_cast
    ... = 1 - ↑n * x - 1*x          : by ring
    ... ≤ (1-x)^n    - 1*x          : sub_le_sub h (le_refl (1*x))
    ... ≤ (1-x)^n   + (- (1*x))     : by ring_nf
    ... ≤ (1-x)^n   + (- (1-x)^n)*x : add_le_add (le_refl _) hm
    ... = (1-x) * (1-x)^n           : by ring
  )


/-
Copyright (c) 2020 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import algebra.hom.equiv.basic
import algebra.hom.aut
import data.zmod.defs
import tactic.group

/-!
# Racks and Quandles

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

This file defines racks and quandles, algebraic structures for sets
that bijectively act on themselves with a self-distributivity
property.  If `R` is a rack and `act : R → (R ≃ R)` is the self-action,
then the self-distributivity is, equivalently, that
```
act (act x y) = act x * act y * (act x)⁻¹
```
where multiplication is composition in `R ≃ R` as a group.
Quandles are racks such that `act x x = x` for all `x`.

One example of a quandle (not yet in mathlib) is the action of a Lie
algebra on itself, defined by `act x y = Ad (exp x) y`.

Quandles and racks were independently developed by multiple
mathematicians.  David Joyce introduced quandles in his thesis
[Joyce1982] to define an algebraic invariant of knot and link
complements that is analogous to the fundamental group of the
exterior, and he showed that the quandle associated to an oriented
knot is invariant up to orientation-reversed mirror image.  Racks were
used by Fenn and Rourke for framed codimension-2 knots and
links in [FennRourke1992].  Unital shelves are discussed in [crans2017].

The name "rack" came from wordplay by Conway and Wraith for the "wrack
and ruin" of forgetting everything but the conjugation operation for a
group.

## Main definitions

* `shelf` is a type with a self-distributive action
* `unital_shelf` is a shelf with a left and right unit
* `rack` is a shelf whose action for each element is invertible
* `quandle` is a rack whose action for an element fixes that element
* `quandle.conj` defines a quandle of a group acting on itself by conjugation.
* `shelf_hom` is homomorphisms of shelves, racks, and quandles.
* `rack.envel_group` gives the universal group the rack maps to as a conjugation quandle.
* `rack.opp` gives the rack with the action replaced by its inverse.

## Main statements
* `rack.envel_group` is left adjoint to `quandle.conj` (`to_envel_group.map`).
  The universality statements are `to_envel_group.univ` and `to_envel_group.univ_uniq`.

## Implementation notes

"Unital racks" are uninteresting (see `rack.assoc_iff_id`, `unital_shelf.assoc`), so we do not
define them.

## Notation

The following notation is localized in `quandles`:

* `x ◃ y` is `shelf.act x y`
* `x ◃⁻¹ y` is `rack.inv_act x y`
* `S →◃ S'` is `shelf_hom S S'`

Use `open_locale quandles` to use these.

## Todo

* If `g` is the Lie algebra of a Lie group `G`, then `(x ◃ y) = Ad (exp x) x` forms a quandle.
* If `X` is a symmetric space, then each point has a corresponding involution that acts on `X`,
  forming a quandle.
* Alexander quandle with `a ◃ b = t * b + (1 - t) * b`, with `a` and `b` elements
  of a module over `Z[t,t⁻¹]`.
* If `G` is a group, `H` a subgroup, and `z` in `H`, then there is a quandle `(G/H;z)` defined by
  `yH ◃ xH = yzy⁻¹xH`.  Every homogeneous quandle (i.e., a quandle `Q` whose automorphism group acts
  transitively on `Q` as a set) is isomorphic to such a quandle.
  There is a generalization to this arbitrary quandles in [Joyce's paper (Theorem 7.2)][Joyce1982].

## Tags

rack, quandle
-/
open mul_opposite

universes u v

/--
A *shelf* is a structure with a self-distributive binary operation.
The binary operation is regarded as a left action of the type on itself.
-/
class shelf (α : Type u) :=
(act : α → α → α)
(self_distrib : ∀ {x y z : α}, act x (act y z) = act (act x y) (act x z))

/--
A *unital shelf* is a shelf equipped with an element `1` such that, for all elements `x`,
we have both `x ◃ 1` and `1 ◃ x` equal `x`.
-/
class unital_shelf (α : Type u) extends shelf α, has_one α :=
(one_act : ∀ a : α, act 1 a = a)
(act_one : ∀ a : α, act a 1 = a)

/--
The type of homomorphisms between shelves.
This is also the notion of rack and quandle homomorphisms.
-/
@[ext]
structure shelf_hom (S₁ : Type*) (S₂ : Type*) [shelf S₁] [shelf S₂] :=
(to_fun : S₁ → S₂)
(map_act' : ∀ {x y : S₁}, to_fun (shelf.act x y) = shelf.act (to_fun x) (to_fun y))

/--
A *rack* is an automorphic set (a set with an action on itself by
bijections) that is self-distributive.  It is a shelf such that each
element's action is invertible.

The notations `x ◃ y` and `x ◃⁻¹ y` denote the action and the
inverse action, respectively, and they are right associative.
-/
class rack (α : Type u) extends shelf α :=
(inv_act : α → α → α)
(left_inv : ∀ x, function.left_inverse (inv_act x) (act x))
(right_inv : ∀ x, function.right_inverse (inv_act x) (act x))

localized "infixr (name := shelf.act) ` ◃ `:65 := shelf.act" in quandles
localized "infixr (name := rack.inv_act) ` ◃⁻¹ `:65 := rack.inv_act" in quandles
localized "infixr (name := shelf_hom) ` →◃ `:25 := shelf_hom" in quandles

open_locale quandles

namespace unital_shelf
open shelf

variables {S : Type*} [unital_shelf S]

/--
A monoid is *graphic* if, for all `x` and `y`, the *graphic identity*
`(x * y) * x = x * y` holds.  For a unital shelf, this graphic
identity holds.
-/
lemma act_act_self_eq (x y : S) : (x ◃ y) ◃ x = x ◃ y :=
begin
  have h : (x ◃ y) ◃ x = (x ◃ y) ◃ (x ◃ 1) := by rw act_one,
  rw [h, ←shelf.self_distrib, act_one],
end

lemma act_idem (x : S) : (x ◃ x) = x := by rw [←act_one x, ←shelf.self_distrib, act_one, act_one]

lemma act_self_act_eq (x y : S) : x ◃ (x ◃ y) = x ◃ y :=
begin
  have h : x ◃ (x ◃ y) = (x ◃ 1) ◃ (x ◃ y) := by rw act_one,
  rw [h, ←shelf.self_distrib, one_act],
end

/--
The associativity of a unital shelf comes for free.
-/
lemma assoc (x y z : S) : (x ◃ y) ◃ z = x ◃ y ◃ z :=
by rw [self_distrib, self_distrib, act_act_self_eq, act_self_act_eq]

end unital_shelf

namespace rack
variables {R : Type*} [rack R]

lemma self_distrib {x y z : R} : x ◃ (y ◃ z) = (x ◃ y) ◃ (x ◃ z) :=
shelf.self_distrib

/--
A rack acts on itself by equivalences.
-/
def act (x : R) : R ≃ R :=
{ to_fun := shelf.act x,
  inv_fun := inv_act x,
  left_inv := left_inv x,
  right_inv := right_inv x }

@[simp] lemma act_apply (x y : R) : act x y = x ◃ y := rfl
@[simp] lemma act_symm_apply (x y : R) : (act x).symm y = x ◃⁻¹ y := rfl
@[simp] lemma inv_act_apply (x y : R) : (act x)⁻¹ y = x ◃⁻¹ y := rfl

@[simp] lemma inv_act_act_eq (x y : R) : x ◃⁻¹ x ◃ y = y := left_inv x y
@[simp] lemma act_inv_act_eq (x y : R) : x ◃ x ◃⁻¹ y = y := right_inv x y

lemma left_cancel (x : R) {y y' : R} : x ◃ y = x ◃ y' ↔ y = y' :=
by { split, apply (act x).injective, rintro rfl, refl }

lemma left_cancel_inv (x : R) {y y' : R} : x ◃⁻¹ y = x ◃⁻¹ y' ↔ y = y' :=
by { split, apply (act x).symm.injective, rintro rfl, refl }

lemma self_distrib_inv {x y z : R} : x ◃⁻¹ y ◃⁻¹ z = (x ◃⁻¹ y) ◃⁻¹ (x ◃⁻¹ z) :=
begin
  rw [←left_cancel (x ◃⁻¹ y), right_inv, ←left_cancel x, right_inv, self_distrib],
  repeat {rw right_inv },
end

/--
The *adjoint action* of a rack on itself is `op'`, and the adjoint
action of `x ◃ y` is the conjugate of the action of `y` by the action
of `x`. It is another way to understand the self-distributivity axiom.

This is used in the natural rack homomorphism `to_conj` from `R` to
`conj (R ≃ R)` defined by `op'`.
-/
lemma ad_conj {R : Type*} [rack R] (x y : R) :
  act (x ◃ y) = act x * act y * (act x)⁻¹ :=
begin
  rw [eq_mul_inv_iff_mul_eq], ext z,
  apply self_distrib.symm,
end

/--
The opposite rack, swapping the roles of `◃` and `◃⁻¹`.
-/
instance opposite_rack : rack Rᵐᵒᵖ :=
{ act := λ x y, op (inv_act (unop x) (unop y)),
  self_distrib := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, mul_opposite.rec $ λ z, begin
    simp only [unop_op, op_inj],
    exact self_distrib_inv,
  end,
  inv_act := λ x y, op (shelf.act (unop x) (unop y)),
  left_inv := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, by simp,
  right_inv := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, by simp }

@[simp] lemma op_act_op_eq {x y : R} : (op x) ◃ (op y) = op (x ◃⁻¹ y) := rfl
@[simp] lemma op_inv_act_op_eq {x y : R} : (op x) ◃⁻¹ (op y) = op (x ◃ y) := rfl

@[simp]
lemma self_act_act_eq {x y : R} : (x ◃ x) ◃ y = x ◃ y :=
by { rw [←right_inv x y, ←self_distrib] }

@[simp]
lemma self_inv_act_inv_act_eq {x y : R} : (x ◃⁻¹ x) ◃⁻¹ y = x ◃⁻¹ y :=
by { have h := @self_act_act_eq _ _ (op x) (op y), simpa using h }

@[simp]
lemma self_act_inv_act_eq {x y : R} : (x ◃ x) ◃⁻¹ y = x ◃⁻¹ y :=
by { rw ←left_cancel (x ◃ x), rw right_inv, rw self_act_act_eq, rw right_inv }

@[simp]
lemma self_inv_act_act_eq {x y : R} : (x ◃⁻¹ x) ◃ y = x ◃ y :=
by { have h := @self_act_inv_act_eq _ _ (op x) (op y), simpa using h }

lemma self_act_eq_iff_eq {x y : R} : x ◃ x = y ◃ y ↔ x = y :=
begin
  split, swap, rintro rfl, refl,
  intro h,
  transitivity (x ◃ x) ◃⁻¹ (x ◃ x),
  rw [←left_cancel (x ◃ x), right_inv, self_act_act_eq],
  rw [h, ←left_cancel (y ◃ y), right_inv, self_act_act_eq],
end

lemma self_inv_act_eq_iff_eq {x y : R} : x ◃⁻¹ x = y ◃⁻¹ y ↔ x = y :=
by { have h := @self_act_eq_iff_eq _ _ (op x) (op y), simpa using h }

/--
The map `x ↦ x ◃ x` is a bijection.  (This has applications for the
regular isotopy version of the Reidemeister I move for knot diagrams.)
-/
def self_apply_equiv (R : Type*) [rack R] : R ≃ R :=
{ to_fun := λ x, x ◃ x,
  inv_fun := λ x, x ◃⁻¹ x,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp }

/--
An involutory rack is one for which `rack.op R x` is an involution for every x.
-/
def is_involutory (R : Type*) [rack R] : Prop := ∀ x : R, function.involutive (shelf.act x)

lemma involutory_inv_act_eq_act {R : Type*} [rack R] (h : is_involutory R) (x y : R) :
  x ◃⁻¹ y = x ◃ y :=
begin
  rw [←left_cancel x, right_inv],
  exact ((h x).left_inverse y).symm,
end

/--
An abelian rack is one for which the mediality axiom holds.
-/
def is_abelian (R : Type*) [rack R] : Prop :=
∀ (x y z w : R), (x ◃ y) ◃ (z ◃ w) = (x ◃ z) ◃ (y ◃ w)

/--
Associative racks are uninteresting.
-/
lemma assoc_iff_id {R : Type*} [rack R] {x y z : R} :
  x ◃ y ◃ z = (x ◃ y) ◃ z ↔ x ◃ z = z :=
by { rw self_distrib, rw left_cancel }

end rack

namespace shelf_hom
variables {S₁ : Type*} {S₂ : Type*} {S₃ : Type*} [shelf S₁] [shelf S₂] [shelf S₃]

instance : has_coe_to_fun (S₁ →◃ S₂) (λ _, S₁ → S₂) := ⟨shelf_hom.to_fun⟩

@[simp] lemma to_fun_eq_coe (f : S₁ →◃ S₂) : f.to_fun = f := rfl

@[simp] lemma map_act (f : S₁ →◃ S₂) {x y : S₁} : f (x ◃ y) = f x ◃ f y := map_act' f

/-- The identity homomorphism -/
def id (S : Type*) [shelf S] : S →◃ S :=
{ to_fun := id,
  map_act' := by simp }

instance inhabited (S : Type*) [shelf S] : inhabited (S →◃ S) :=
⟨id S⟩

/-- The composition of shelf homomorphisms -/
def comp (g : S₂ →◃ S₃) (f : S₁ →◃ S₂) : S₁ →◃ S₃ :=
{ to_fun := g.to_fun ∘ f.to_fun,
  map_act' := by simp }

@[simp]
lemma comp_apply (g : S₂ →◃ S₃) (f : S₁ →◃ S₂) (x : S₁) :
  (g.comp f) x = g (f x) := rfl

end shelf_hom

/--
A quandle is a rack such that each automorphism fixes its corresponding element.
-/
class quandle (α : Type*) extends rack α :=
(fix : ∀ {x : α}, act x x = x)

namespace quandle
open rack
variables {Q : Type*} [quandle Q]

attribute [simp] fix

@[simp]
lemma fix_inv {x : Q} : x ◃⁻¹ x = x :=
by { rw ←left_cancel x, simp }

instance opposite_quandle : quandle Qᵐᵒᵖ :=
{ fix := λ x, by { induction x using mul_opposite.rec, simp } }

/--
The conjugation quandle of a group.  Each element of the group acts by
the corresponding inner automorphism.
-/
@[nolint has_nonempty_instance]
def conj (G : Type*) := G

instance conj.quandle (G : Type*) [group G] : quandle (conj G) :=
{ act := (λ x, @mul_aut.conj G _ x),
  self_distrib := λ x y z, begin
    dsimp only [mul_equiv.coe_to_equiv, mul_aut.conj_apply, conj],
    group,
  end,
  inv_act := (λ x, (@mul_aut.conj G _ x).symm),
  left_inv := λ x y, by { dsimp [act, conj], group },
  right_inv := λ x y, by { dsimp [act, conj], group },
  fix := λ x, by simp }

@[simp]
lemma conj_act_eq_conj {G : Type*} [group G] (x y : conj G) :
  x ◃ y = ((x : G) * (y : G) * (x : G)⁻¹ : G) := rfl

lemma conj_swap {G : Type*} [group G] (x y : conj G) :
  x ◃ y = y ↔ y ◃ x = x :=
begin
  dsimp [conj] at *, split,
  repeat { intro h, conv_rhs { rw eq_mul_inv_of_mul_eq (eq_mul_inv_of_mul_eq h) }, simp, },
end

/--
`conj` is functorial
-/
def conj.map {G : Type*} {H : Type*} [group G] [group H] (f : G →* H) : conj G →◃ conj H :=
{ to_fun := f,
  map_act' := by simp }

instance {G : Type*} {H : Type*} [group G] [group H] : has_lift (G →* H) (conj G →◃ conj H) :=
{ lift := conj.map }

/--
The dihedral quandle. This is the conjugation quandle of the dihedral group restrict to flips.

Used for Fox n-colorings of knots.
-/
@[nolint has_nonempty_instance]
def dihedral (n : ℕ) := zmod n

/--
The operation for the dihedral quandle.  It does not need to be an equivalence
because it is an involution (see `dihedral_act.inv`).
-/
def dihedral_act (n : ℕ) (a : zmod n) : zmod n → zmod n :=
λ b, 2 * a - b

lemma dihedral_act.inv (n : ℕ) (a : zmod n) : function.involutive (dihedral_act n a) :=
by { intro b, dsimp [dihedral_act], ring }

instance (n : ℕ) : quandle (dihedral n) :=
{ act := dihedral_act n,
  self_distrib := λ x y z, begin
    dsimp [dihedral_act], ring,
  end,
  inv_act := dihedral_act n,
  left_inv := λ x, (dihedral_act.inv n x).left_inverse,
  right_inv := λ x, (dihedral_act.inv n x).right_inverse,
  fix := λ x, begin
    dsimp [dihedral_act], ring,
  end }

end quandle

namespace rack

/--
This is the natural rack homomorphism to the conjugation quandle of the group `R ≃ R`
that acts on the rack.
-/
def to_conj (R : Type*) [rack R] : R →◃ quandle.conj (R ≃ R) :=
{ to_fun := act,
  map_act' := ad_conj }

section envel_group

/-!
### Universal enveloping group of a rack

The universal enveloping group `envel_group R` of a rack `R` is the
universal group such that every rack homomorphism `R →◃ conj G` is
induced by a unique group homomorphism `envel_group R →* G`.
For quandles, Joyce called this group `AdConj R`.

The `envel_group` functor is left adjoint to the `conj` forgetful
functor, and the way we construct the enveloping group is via a
technique that should work for left adjoints of forgetful functors in
general.  It involves thinking a little about 2-categories, but the
payoff is that the map `envel_group R →* G` has a nice description.

Let's think of a group as being a one-object category.  The first step
is to define `pre_envel_group`, which gives formal expressions for all
the 1-morphisms and includes the unit element, elements of `R`,
multiplication, and inverses.  To introduce relations, the second step
is to define `pre_envel_group_rel'`, which gives formal expressions
for all 2-morphisms between the 1-morphisms.  The 2-morphisms include
associativity, multiplication by the unit, multiplication by inverses,
compatibility with multiplication and inverses (`congr_mul` and
`congr_inv`), the axioms for an equivalence relation, and,
importantly, the relationship between conjugation and the rack action
(see `rack.ad_conj`).

None of this forms a 2-category yet, for example due to lack of
associativity of `trans`.  The `pre_envel_group_rel` relation is a
`Prop`-valued version of `pre_envel_group_rel'`, and making it
`Prop`-valued essentially introduces enough 3-isomorphisms so that
every pair of compatible 2-morphisms is isomorphic.  Now, while
composition in `pre_envel_group` does not strictly satisfy the category
axioms, `pre_envel_group` and `pre_envel_group_rel'` do form a weak
2-category.

Since we just want a 1-category, the last step is to quotient
`pre_envel_group` by `pre_envel_group_rel'`, and the result is the
group `envel_group`.

For a homomorphism `f : R →◃ conj G`, how does
`envel_group.map f : envel_group R →* G` work?  Let's think of `G` as
being a 2-category with one object, a 1-morphism per element of `G`,
and a single 2-morphism called `eq.refl` for each 1-morphism.  We
define the map using a "higher `quotient.lift`" -- not only do we
evaluate elements of `pre_envel_group` as expressions in `G` (this is
`to_envel_group.map_aux`), but we evaluate elements of
`pre_envel_group'` as expressions of 2-morphisms of `G` (this is
`to_envel_group.map_aux.well_def`).  That is to say,
`to_envel_group.map_aux.well_def` recursively evaluates formal
expressions of 2-morphisms as equality proofs in `G`.  Now that all
morphisms are accounted for, the map descends to a homomorphism
`envel_group R →* G`.

Note: `Type`-valued relations are not common.  The fact it is
`Type`-valued is what makes `to_envel_group.map_aux.well_def` have
well-founded recursion.
-/

/--
Free generators of the enveloping group.
-/
inductive pre_envel_group (R : Type u) : Type u
| unit : pre_envel_group
| incl (x : R) : pre_envel_group
| mul (a b : pre_envel_group) : pre_envel_group
| inv (a : pre_envel_group) : pre_envel_group

instance pre_envel_group.inhabited (R : Type u) : inhabited (pre_envel_group R) :=
⟨pre_envel_group.unit⟩

open pre_envel_group

/--
Relations for the enveloping group. This is a type-valued relation because
`to_envel_group.map_aux.well_def` inducts on it to show `to_envel_group.map`
is well-defined.  The relation `pre_envel_group_rel` is the `Prop`-valued version,
which is used to define `envel_group` itself.
-/
inductive pre_envel_group_rel' (R : Type u) [rack R] :
  pre_envel_group R → pre_envel_group R → Type u
| refl {a : pre_envel_group R} : pre_envel_group_rel' a a
| symm {a b : pre_envel_group R} (hab : pre_envel_group_rel' a b) : pre_envel_group_rel' b a
| trans {a b c : pre_envel_group R}
  (hab : pre_envel_group_rel' a b) (hbc : pre_envel_group_rel' b c) : pre_envel_group_rel' a c
| congr_mul {a b a' b' : pre_envel_group R}
  (ha : pre_envel_group_rel' a a') (hb : pre_envel_group_rel' b b') :
  pre_envel_group_rel' (mul a b) (mul a' b')
| congr_inv {a a' : pre_envel_group R} (ha : pre_envel_group_rel' a a') :
  pre_envel_group_rel' (inv a) (inv a')
| assoc (a b c : pre_envel_group R) : pre_envel_group_rel' (mul (mul a b) c) (mul a (mul b c))
| one_mul (a : pre_envel_group R) : pre_envel_group_rel' (mul unit a) a
| mul_one (a : pre_envel_group R) : pre_envel_group_rel' (mul a unit) a
| mul_left_inv (a : pre_envel_group R) : pre_envel_group_rel' (mul (inv a) a) unit
| act_incl (x y : R) :
  pre_envel_group_rel' (mul (mul (incl x) (incl y)) (inv (incl x))) (incl (x ◃ y))

instance pre_envel_group_rel'.inhabited (R : Type u) [rack R] :
  inhabited (pre_envel_group_rel' R unit unit) :=
⟨pre_envel_group_rel'.refl⟩

/--
The `pre_envel_group_rel` relation as a `Prop`.  Used as the relation for `pre_envel_group.setoid`.
-/
inductive pre_envel_group_rel (R : Type u) [rack R] : pre_envel_group R → pre_envel_group R → Prop
| rel {a b : pre_envel_group R} (r : pre_envel_group_rel' R a b) : pre_envel_group_rel a b

/--
A quick way to convert a `pre_envel_group_rel'` to a `pre_envel_group_rel`.
-/
lemma pre_envel_group_rel'.rel {R : Type u} [rack R] {a b : pre_envel_group R} :
  pre_envel_group_rel' R a b → pre_envel_group_rel R a b :=
pre_envel_group_rel.rel

@[refl]
lemma pre_envel_group_rel.refl {R : Type u} [rack R] {a : pre_envel_group R} :
  pre_envel_group_rel R a a :=
pre_envel_group_rel.rel pre_envel_group_rel'.refl

@[symm]
lemma pre_envel_group_rel.symm {R : Type u} [rack R] {a b : pre_envel_group R} :
  pre_envel_group_rel R a b → pre_envel_group_rel R b a
| ⟨r⟩ := r.symm.rel

@[trans]
lemma pre_envel_group_rel.trans {R : Type u} [rack R] {a b c : pre_envel_group R} :
  pre_envel_group_rel R a b → pre_envel_group_rel R b c → pre_envel_group_rel R a c
| ⟨rab⟩ ⟨rbc⟩ := (rab.trans rbc).rel

instance pre_envel_group.setoid (R : Type*) [rack R] : setoid (pre_envel_group R) :=
{ r := pre_envel_group_rel R,
  iseqv := begin
    split, apply pre_envel_group_rel.refl,
    split, apply pre_envel_group_rel.symm,
    apply pre_envel_group_rel.trans
  end }

/--
The universal enveloping group for the rack R.
-/
def envel_group (R : Type*) [rack R] := quotient (pre_envel_group.setoid R)

-- Define the `group` instances in two steps so `inv` can be inferred correctly.
-- TODO: is there a non-invasive way of defining the instance directly?
instance (R : Type*) [rack R] : div_inv_monoid (envel_group R) :=
{ mul := λ a b, quotient.lift_on₂ a b
                  (λ a b, ⟦pre_envel_group.mul a b⟧)
                  (λ a b a' b' ⟨ha⟩ ⟨hb⟩,
                    quotient.sound (pre_envel_group_rel'.congr_mul ha hb).rel),
  one := ⟦unit⟧,
  inv := λ a, quotient.lift_on a
                (λ a, ⟦pre_envel_group.inv a⟧)
                (λ a a' ⟨ha⟩,
                  quotient.sound (pre_envel_group_rel'.congr_inv ha).rel),
  mul_assoc := λ a b c,
    quotient.induction_on₃ a b c (λ a b c, quotient.sound (pre_envel_group_rel'.assoc a b c).rel),
  one_mul := λ a,
    quotient.induction_on a (λ a, quotient.sound (pre_envel_group_rel'.one_mul a).rel),
  mul_one := λ a,
    quotient.induction_on a (λ a, quotient.sound (pre_envel_group_rel'.mul_one a).rel),}

instance (R : Type*) [rack R] : group (envel_group R) :=
{ mul_left_inv := λ a,
    quotient.induction_on a (λ a, quotient.sound (pre_envel_group_rel'.mul_left_inv a).rel),
  .. envel_group.div_inv_monoid _ }

instance envel_group.inhabited (R : Type*) [rack R] : inhabited (envel_group R) := ⟨1⟩

/--
The canonical homomorphism from a rack to its enveloping group.
Satisfies universal properties given by `to_envel_group.map` and `to_envel_group.univ`.
-/
def to_envel_group (R : Type*) [rack R] : R →◃ quandle.conj (envel_group R) :=
{ to_fun := λ x, ⟦incl x⟧,
  map_act' := λ x y, quotient.sound (pre_envel_group_rel'.act_incl x y).symm.rel }

/--
The preliminary definition of the induced map from the enveloping group.
See `to_envel_group.map`.
-/
def to_envel_group.map_aux {R : Type*} [rack R] {G : Type*} [group G]
  (f : R →◃ quandle.conj G) : pre_envel_group R → G
| unit := 1
| (incl x) := f x
| (mul a b) := to_envel_group.map_aux a * to_envel_group.map_aux b
| (inv a) := (to_envel_group.map_aux a)⁻¹

namespace to_envel_group.map_aux
open pre_envel_group_rel'

/--
Show that `to_envel_group.map_aux` sends equivalent expressions to equal terms.
-/
lemma well_def {R : Type*} [rack R] {G : Type*} [group G] (f : R →◃ quandle.conj G) :
  Π {a b : pre_envel_group R}, pre_envel_group_rel' R a b →
  to_envel_group.map_aux f a = to_envel_group.map_aux f b
| a b refl := rfl
| a b (symm h) := (well_def h).symm
| a b (trans hac hcb) := eq.trans (well_def hac) (well_def hcb)
| _ _ (congr_mul ha hb) := by { simp [to_envel_group.map_aux, well_def ha, well_def hb] }
| _ _ (congr_inv ha) := by { simp [to_envel_group.map_aux, well_def ha] }
| _ _ (assoc a b c) := by { apply mul_assoc }
| _ _ (one_mul a) := by { simp [to_envel_group.map_aux] }
| _ _ (mul_one a) := by { simp [to_envel_group.map_aux] }
| _ _ (mul_left_inv a) := by { simp [to_envel_group.map_aux] }
| _ _ (act_incl x y) := by { simp [to_envel_group.map_aux] }

end to_envel_group.map_aux

/--
Given a map from a rack to a group, lift it to being a map from the enveloping group.
More precisely, the `envel_group` functor is left adjoint to `quandle.conj`.
-/
def to_envel_group.map {R : Type*} [rack R] {G : Type*} [group G] :
  (R →◃ quandle.conj G) ≃ (envel_group R →* G) :=
{ to_fun := λ f,
  { to_fun := λ x, quotient.lift_on x (to_envel_group.map_aux f)
                    (λ a b ⟨hab⟩, to_envel_group.map_aux.well_def f hab),
    map_one' := begin
      change quotient.lift_on ⟦rack.pre_envel_group.unit⟧ (to_envel_group.map_aux f) _ = 1,
      simp [to_envel_group.map_aux],
    end,
    map_mul' := λ x y, quotient.induction_on₂ x y (λ x y, begin
      change quotient.lift_on ⟦mul x y⟧ (to_envel_group.map_aux f) _ = _,
      simp [to_envel_group.map_aux],
    end) },
  inv_fun := λ F, (quandle.conj.map F).comp (to_envel_group R),
  left_inv := λ f, by { ext, refl },
  right_inv := λ F, monoid_hom.ext $ λ x, quotient.induction_on x $ λ x, begin
    induction x,
    { exact F.map_one.symm, },
    { refl, },
    { have hm : ⟦x_a.mul x_b⟧ = @has_mul.mul (envel_group R) _ ⟦x_a⟧ ⟦x_b⟧ := rfl,
      rw [hm, F.map_mul, monoid_hom.map_mul, ←x_ih_a, ←x_ih_b] },
    { have hm : ⟦x_a.inv⟧ = @has_inv.inv (envel_group R) _ ⟦x_a⟧ := rfl,
      rw [hm, F.map_inv, monoid_hom.map_inv, x_ih], }
  end, }

/--
Given a homomorphism from a rack to a group, it factors through the enveloping group.
-/
lemma to_envel_group.univ (R : Type*) [rack R] (G : Type*) [group G]
  (f : R →◃ quandle.conj G) :
  (quandle.conj.map (to_envel_group.map f)).comp (to_envel_group R) = f :=
to_envel_group.map.symm_apply_apply f

/--
The homomorphism `to_envel_group.map f` is the unique map that fits into the commutative
triangle in `to_envel_group.univ`.
-/
lemma to_envel_group.univ_uniq (R : Type*) [rack R] (G : Type*) [group G]
  (f : R →◃ quandle.conj G)
  (g : envel_group R →* G) (h : f = (quandle.conj.map g).comp (to_envel_group R)) :
  g = to_envel_group.map f :=
h.symm ▸ (to_envel_group.map.apply_symm_apply g).symm

/--
The induced group homomorphism from the enveloping group into bijections of the rack,
using `rack.to_conj`. Satisfies the property `envel_action_prop`.

This gives the rack `R` the structure of an augmented rack over `envel_group R`.
-/
def envel_action {R : Type*} [rack R] : envel_group R →* (R ≃ R) :=
to_envel_group.map (to_conj R)

@[simp]

end envel_group

end rack


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

# Inductive Types : Natural Numbers
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import lectures.lec12_gaussian_integers
import lectures.lec13_structures_on_gaussian_int

/-
Overview of this code:
1. Natural Numbers
2. Predicates on Natural Numbers
3. Induction
-/

namespace PROOFS

variables {X Y : Type}

------------------------------
--------Natural Numbers----
------------------------------

/-
1.  Every natural number is either `zero` or `succ n`, for a previously defined natural number `n`.
2. The type `nat` of natural numbers, which is defined in the Lean mathlib library, is the archetypal exmaple of an __inductive__ type.
3. However, for the sole purpose of pedagogy we are going to define our own adhoc inductive type of natural numbers. It is defined in the same way as in the mathlib, but we give it a different name so that we can prove our own theorem without any previous knowledge. So far, we have taken the knowledge of natural numbers for granted, and we have relied on mathlib. Now, for the first time we will understand what statements like `∀ m n : mat, m + n = n + m` are true in virute of the construction of natural numbers.
-/

/- mat short for  mynat -/

inductive mat : Type
| zero : mat -- pattern 1 (constructor `zero`)
| succ : mat → mat -- pattern 2 (constructor `succ`)
-- there are two cases; either a natural number is zero or is the successor of a previously defined natural number.

/- 3 = succ 2 = succ (succ 1) = succ (succ (succ 0)) -/

/- There are two __constructors__. We start with `zero : nat`; it takes no arguments, so we have it from the start. In contrast, the constructor `succ` can only be applied to a previously constructed nat. Applying it to zero yields `succ zero : mat`. Applying it again yields `succ (succ zero) : mat`, and so on.
-/

#check mat

#check mat.zero -- zero constructor
#check mat.succ -- succ constructor

namespace mat

instance : has_zero mat := ⟨mat.zero⟩ --zero here is mat.zero since we are inside in the namespace `mat`.

@[simp]
lemma zero_def :
  mat.zero = 0 :=
begin
  refl,
end

def one := succ 0 -- this works because 0 := zero in the type class has_zero

instance : has_one mat := ⟨one⟩

def two := succ 1

def three := succ two

def four := succ three

def five := succ (succ three)

example :
  five = succ (four) :=
begin
  refl,
end

example :
  five = succ (succ (succ (two))) :=
begin
  refl,
end

#reduce three
#reduce four

example (m : mat) (h : succ m = two) :
  succ(succ(m)) = three :=
begin
  rw h,
  refl,
end

theorem no_conf : -- short for no_confusion
  ∀ m : mat, 0 ≠ succ (m) :=
begin
  intro m,
  intro h,
  contradiction, -- the free generation of mat under the constructors `zero` and `succ` means there cannot be any non-rfl equations between terms of `mat`
end

theorem succ_inj (m n : mat) :
  m.succ = n.succ → m = n :=
begin
  intro h,
  simp at h,
  exact h,
end

/-
What does it mean that `mat` is indutively defined? Intuitively, `mat` is the “smallest” type with these two constructors, meaning that it is __exhaustively__ and __freely__ generated by starting with `zero` and applying `succ` repeatedly.
As a consequence to define a function, say `f`, out of `mat` all we need to do is to specify the value of `f` at `zero` and the value of `f` at `succ n` for `n : mat`.

This is the idea behind __recursion__.
-/

@[simp]
def pred : mat → mat -- predecessor function
| 0 := 0
| (succ n) := n

#check pred

@[simp]
lemma pred_succ :
   pred ∘ succ = id :=
begin
  funext n,
  dsimp,
  cases n,
  {
    refl,
  },
  {
    refl,
  }
end

@[simp]
lemma succ_pred (k : mat) (h : ∃ m : mat, k = succ m):
  succ (pred k) = k :=
begin
  cases h with n hn,
  rw hn,
  refl,
end

/-
Another example of recursion: For instance the constant function `mat → bool` at `ff`:
-/

def constant_ff_of_mat : mat → bool
| 0 := ff
| (succ n) := constant_ff_of_mat n -- this definition is recursive since the value of `constant_ff_of_mat` at `succ n` is expressed in term of the value of  `constant_ff_of_mat` at `n` (one lower). This process halts at `zero`.

def constant_ff_of_mat_alt : mat → bool  := λ b, ff -- what is the difference between this function and the one above

#reduce bool_of_nat

-- define it by pattern matching
def bool_of_mat : mat → bool
| 0 := ff
| (succ n) := tt

def bad : mat → mat
| zero := zero
| (succ n) := succ (bad (succ n))

#check one + two

-- note what just happened:
def thirty_seven_error : mat := 37 -- what is 37?

-- define it recursively
def two_add : mat → mat
-- define two_add to be a function which takes a natural number n and returns 2 + n
| 0 := two
| (succ n) := succ (two_add (n))

/- `two_add 1 = two_add (succ 0)  by pattern matching
              = succ (two_add 0) by definition of two_add; second pattern
              = succ (two)  by definition of two_add; first pattern
              = three by definition of three
-/

example :
  two_add two = four :=
begin
  refl,
end

def add : mat → mat → mat
-- λ m, (add m : mat → mat)
| m 0 := m
| m (succ n) := succ (add m n)

example :
  add two two = four :=
begin
  refl,
end

instance : has_add mat := ⟨add⟩

#check one + two

def thirty_seven : mat := 37

-- another example of recursive function
def double : mat → mat
| 0 := 0
| (succ n) := double n + 2

example :
  double 1 = 2 :=
begin
  refl,
end

@[simp]
lemma add_zero (m : mat) :
  m + 0 = m :=
begin
  refl, -- works because of the defn of addition
end

@[simp]
lemma add_one (m : mat) :
  m + 1 = succ (m) :=
begin
  refl,
end

@[simp]
lemma add_succ (m n : mat) :
  m + succ n = succ (m + n) :=
begin
  refl,
end

lemma zero_add' (m : mat) :
  0 + m = m :=
begin
  cases m,
  {
    refl,
  },
  {
    rw add_succ,
    -- we cannot do this because this is our original problem -- to do this we need some more tools (induction).
  }
end

/-
__The Principle of Induction for Natural Numbers__:
Let `P` be any property of natural numbers, i.e. P : ℕ → Prop (e.g. `P m = (0 + m =m)` ). Suppose `P` holds of zero (i.e. `P 0` holds), and whenever `P` holds of a natural number `n`, then it holds of its successor, `succ n` (i.e. we have a proof of `P n → P succ(n)` ). Then `P` holds of every natural number `n` (i.e. `∀ n : ℕ, P n` ).

`P 0 ∧ ( ∀ n, P n → P succ(n) ) →  ∀ n, P n`.

                          ---------
                          `P n` (the induction hypothesis)
                          .
                          .
                          .
`P 0` (the base case)     `P (succ n)`
------------------------------------
          ∀ n, P n

Induction  works very similar to `cases`  but it gives us an extra assumption when proving the successor case, which we usually label `ih` (or something similar) for the induction hypothesis.
-/

@[simp]
lemma zero_add  :
  ∀ m : mat, 0 + m = m :=  -- has the form of `∀ m : mat, P m`
begin
  intro m,
  induction m with n ihn, -- the important difference between tactic `induction` is that we now have an extra assumption `ihn` in the context which will be crucial
  {
    -- proving base case `P 0`
    refl,
  },
  {-- the inductive step: assuming `P n` and proving  `P succ(n)`
    rw add_succ,
    rw ihn,
  },
end

@[simp]
lemma one_add (n : mat) : 1 + n = succ n :=
begin
  induction n with d ihd, -- ihd stands for "inductive hypothesis"
  {
    refl,
  },
  {
    rw add_succ, -- changes lhs `1 + d.succ` to `(1 + d).succ`
    rw ihd,
  },
end

-- We isolate some useful facts and prove them first
@[simp]
lemma succ_add (a b : mat) : succ a + b = succ (a + b) :=
begin
  induction b with d ihd,
  { -- base case when b = 0
    refl,
  },
  { -- supposing `succ a + i = succ (a + i)` we want to prove `a.succ + i.succ = (a + i.succ).succ`.
    rw add_succ, -- bring `i` into the addition.
    rw ihd,
    refl,
  }
end

lemma add_comm (m n : mat) : m + n = n + m :=
begin
  induction m with d ihd,
  {
    show 0 + n = n + 0,
    rw add_zero, -- simplified `n + 0` to `n`
    rw zero_add,
  },
  {
    rw add_succ, --changed `n + d.succ` to `(n + d).succ`
    rw ← ihd,
    --rw ← add_succ,
    rw succ_add,
  },
end

lemma add_assoc (a b c : mat) : (a + b) + c = a + (b + c) :=
begin
  induction c with d ihd,
  {
    -- (a + b) + zero = a + (b + zero)
    show (a + b) + 0 = a + (b + 0),
    repeat {rw add_zero},
  },
  {
    rw add_succ,
    rw add_succ,
    rw add_succ,
    rw ihd,
  },
end

namespace STR
open PROOFS.STR

instance : comm_additive_monoid_str mat :=
{
  add := mat.add,
  add_assoc := mat.add_assoc,
  zero := 0,
  add_zero := mat.add_zero,
  zero_add := mat.zero_add,
  add_comm := mat.add_comm,
}

end STR

lemma succ_inj' :
  is_injective succ :=
begin
  unfold is_injective,
  intros a b, -- introduced these to prove ∀
  intro h, -- introduce `h` to prove →
  induction a with d ihd,
  {
    show 0 = b,
    induction b with c ihc,
    {
      refl,
    },
    {
      sorry, -- maybe this is a deadend approach, we have to reevaluate our strategy.
    },
  },
  {
    sorry,
  },
end

def mul : mat → mat → mat
-- λ m, (add m : mat → mat)
| m 0 := 0
| m (succ n) :=  (mul m n) + m -- m * (n + 1) should return m * n + m

lemma mul_zero' (m : mat) :
  mul m 0 =  0 :=
begin
  refl, -- definitional equality based on the first line of the defn of mul
end

instance : has_mul mat := ⟨mul⟩

@[simp]
lemma mul_zero (m : mat) :
   m * 0 =  0 :=
begin
  refl, -- definitional equality based on the first line of the defn of mul
end

@[simp]
lemma mul_succ (m n : mat) :
   m * (succ n) =  m * n + m :=
begin
  refl, -- definitional equality based on the second line of defn of mul
end

@[simp]
lemma mul_one (m : mat) :
  m * 1 = m :=
begin
  suffices h : m * 1 = 0 + m, from zero_add m,
  refl,
end

@[simp]
lemma zero_mul (m : mat) :
   0 * m =  0 :=
begin
  induction m with d ihd,
  {
    refl,
  },
  {
    rw mul_succ,
    rw add_zero,
    rw ihd,
  }
end

#check mat.mul_zero

@[simp]
lemma one_mul (m : mat) :
  1 * m = m :=
begin
  induction m with d ihd,
  {
    show (1 : mat) * 0 = 0, from (mat.mul_zero 1),
  },
  {
    rw mul_succ,
    rw ihd,
    rw add_one,
  },
end

/- We define recursively a function `sum_up_to : mat → mat` which assigns to `m : mat` the sum of natural numbers up to (and including) `m`, i.e. the value `sum_up n` is the sum of `1, ..., n`. -/

def sum_up_to : mat → mat
--
-- therefore,
| 0 := 0
| (succ n) := sum_up_to n + succ n

-- testing
example :
  sum_up_to 5 = 15 :=
begin
  refl,
end

end mat
end PROOFS


import tactic

#check mul_add
#check dvd_mul_right
#check add_sub_cancel
#check add_sub_cancel'

variables {x d f g : ℤ}
variables {a b c e m n t : ℕ}

-- BEGIN
/- Prove that for x, d ∈ ℤ, if x divides x + d,
   then x also divides d. -/
example (divxd : x ∣ x + d) : x ∣ d :=
begin
  cases divxd with f beq,
  use f - 1,
  rw mul_sub,
  rw ← beq,
  rw [mul_one, add_sub_cancel' x d], -- or, ring
end

/- A similar proof: prove that for a, b, c ∈ ℕ, if a ∣ b and a ∣ c,
   then a ∣ (b + c). -/
example (divab : a ∣ b) (divac : a ∣ c) : a ∣ (b + c) :=
begin
  cases divab with d beq,
  cases divac with e ceq,
  rw [beq, ceq],
  rw ← mul_add,
  exact dvd_mul_right a (d + e),
end

example (divab : a ∣ b) (divac : a ∣ c) : a ∣ (b + c) :=
begin
  cases divab with d beq,
  cases divac with e ceq,
  rw [beq, ceq],
  rw ← mul_add,
  use (d + e),
end

example (h : t ∣ m) (h' : t ∣ n) : t ∣ a * m + b * n :=
begin
  cases h with c hc,
  cases h' with e he,
  rw [hc, he],
  rw [mul_comm, mul_assoc, mul_comm b, mul_assoc t],
  rw ← mul_add,
  use (c * a + e * b),
end
-- END


-- Monotonía de la suma por la izquierda en Lean
-- =============================================

-- Demostrar que si a, b y c son números reales
-- tales que a ≤ b, entonces c + a ≤ c + b.

import data.real.basic

variables {a b c : ℝ}

-- 1ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  have h : (c + b) - (c + a) = b - a,
  { ring, },
  { rw h,
    rw sub_nonneg,
    exact hab, },
end

-- 2ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  calc
    0   ≤ b - a
            : by exact sub_nonneg.mpr hab
    ... = c + b - (c + a)
            : by exact (add_sub_add_left_eq_sub b a c).symm,
end

-- 3ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  calc
  0   ≤ b - a
          : sub_nonneg.mpr hab
  ... = c + b - (c + a)
          : (add_sub_add_left_eq_sub b a c).symm,
end

-- 4ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  calc 0   ≤ b - a           : sub_nonneg.mpr hab
       ... = c + b - (c + a) : by ring
end

-- 5ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  simp,
  exact hab,
end

-- 6ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  rw ← sub_nonneg,
  simp [hab],
end

-- 7ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
begin
  simp [hab],
end

-- 8ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
by simp [hab]

-- 9ª demostración
example
  (d : ℝ)
  (hab : a ≤ b)
  : d + a ≤ d + b :=
add_le_add_left hab d

-- 10ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
by linarith

-- 11ª demostración
example
  (hab : a ≤ b)
  : c + a ≤ c + b :=
by finish


import Katydid.Std.Algebra

instance : Repr Ordering where
  reprPrec
    | Ordering.lt, _ => "<"
    | Ordering.gt, _ => ">"
    | Ordering.eq, _ => "="

namespace Ordering

-- lexicographical ordering
def lex (x: Ordering) (y: Ordering): Ordering :=
  match x with
  | Ordering.eq => y
  | _ => x

theorem lex_assoc:
  ∀ a b c, lex (lex a b) c = lex a (lex b c) := by
  intros a b c
  cases a <;> simp [lex]

theorem lex_assoc' (a b c: Ordering):
  lex (lex a b) c = lex a (lex b c) := by
  cases a
  {
    case lt => rfl
  }
  case eq => rfl
  case gt => rfl

theorem lex_assoc'' (a b c: Ordering):
  lex (lex a b) c = lex a (lex b c) :=
  by cases a with
  | eq => rfl
  | lt => rfl
  | gt => rfl

theorem lex_assoc''' (a b c: Ordering):
  lex (lex a b) c = lex a (lex b c) :=
  match a with
  | Ordering.eq => rfl
  | Ordering.lt => by rfl
  | Ordering.gt => by rfl

theorem lex_left_identity (a: Ordering):
  lex Ordering.eq a = a := by
  cases a <;> rfl

theorem lex_right_identity (a: Ordering):
  lex a Ordering.eq = a := by
  cases a <;> rfl

theorem lex_right_identity':
  ∀ x, lex x Ordering.eq = x := by
  intro x
  cases x
  · rfl
  · rfl
  · rfl

theorem lex_right_identity'':
  ∀ x, lex x Ordering.eq = x := by
  intro x
  cases x
  { rfl }
  { rfl }
  { rfl }

end Ordering

instance : Magma Ordering where
  op a b := Ordering.lex a b

instance : Semigroup Ordering where
  is_assoc := Ordering.lex_assoc

instance : Monoid Ordering where
  empty := Ordering.eq
  left_identity := Ordering.lex_left_identity
  right_identity := Ordering.lex_right_identity

section instances_using_structure'

  open algebra_using_structure'

  def instanceMagmaLex := Magma'Struct.mk Ordering Ordering.lex
  def instanceMagmaLex': Magma'Struct := {
    carrier := Ordering,
    op := Ordering.lex
  }

  def instanceSemigroupLex : Semigroup'Struct := {
    toMagma'Struct := instanceMagmaLex,
    is_assoc := Ordering.lex_assoc
  }
  def instanceSemigroupLex' : Semigroup'Struct := {
    carrier := Ordering,
    op := Ordering.lex,
    is_assoc := Ordering.lex_assoc
  }

  def instanceMonoidLex : Monoid'Struct := {
    carrier := Ordering,
    op := Ordering.lex,
    is_assoc := Ordering.lex_assoc,
    e := Ordering.eq,
    left_identity := Ordering.lex_left_identity,
    right_identity := Ordering.lex_right_identity,
  }
  def instanceMonoidLex' : Monoid'Struct := {
    toSemigroup'Struct := instanceSemigroupLex,
    e := Ordering.eq,
    left_identity := Ordering.lex_left_identity,
    right_identity := Ordering.lex_right_identity,
  }

end instances_using_structure'


import tactic           -- import all the tactics
import data.nat.prime_norm_num   -- import ℕ natural numbers
import data.real.basic  -- import ℝ real numbers
import data.real.irrational  -- allows us to talk about irrational numbers

variables (α β: Type)
variables (A B C D: set α)
variables (a x y: α)
open set nat

/-
A set in Lean can only contain elements of the same type.

So for any type `α : Type` there is a type of `set α : Type`

The terms of this type are sets containing elements of type α

So if `S : set ℕ` then `S` is a set containing only natural numbers.

Suppose we also have a set `T : set ℝ`, containing only real numbers.

As mathematicians we could happily form their intersection `S ∩ T`
but this doesn't work in Lean! -/

variable (S : set ℕ)
variable (T : set ℝ)

--#check S ∩ T    -- type mismatch at application `S ∩ T` term `T` has
                  /- type `set ℝ` but is expected to have type `set ℕ`

Another obvious difference between sets in Lean and in maths is that
we would usually call S a subset of ℕ and write `S ⊆ ℕ`

Unfortunately this also doesn't work in Lean: `ℕ` is a Type not a set. -/

--#check S ⊆ ℕ -- type mismatch at application S ⊆ ℕ term ℕ has type Type : Type 1
                /- but is expected to have type set ℕ : Type

A `predicate` on a type α is a function `α → Prop`

For example `nat.prime: ℕ → Prop` is the predicate telling us whether
or not `n : ℕ` is `prime`.

Given any set A whose elements all have type α there is a predicate on α
given by `x ∈ A`.

In Lean `A : set α`  is defined to be this predicate.

Sets can be written in standard set-builder notation

For example `{p : ℕ | nat.prime p}` is the set of primes

Here are some more examples:

`{n : ℕ | n ≤ 10}`  the set ℕ containing all nats ≤ 10
`{x : ℝ | irrational x}`  the set ℝ containing all irrational numbers

Note that in each case the elements of each set are of `a fixed type`. -/

--#check {p : ℕ | nat.prime p} -- : set ℕ
--#check {n : ℕ | n ≤ 10}      -- : set ℕ
--#check {x : ℝ | irrational x} -- : set ℝ

variable (Pr : α → Prop)  -- a predicate on α
-- The set defined by a predicate equals the predicate

-- 01
example : {a : α | Pr a} = Pr :=
begin
  refl,
end

-- 02
example : {p : ℕ | nat.prime p} = nat.prime :=
begin
  sorry,
end

/-
The way we refer to membership of a set is with `∈` (type `\in`)
For any  `x : α`  we have  `x ∈ A` iff `Pr x` -/
-- 03
example : x ∈ { a | Pr a} ↔ Pr x:=
begin
   sorry,
end

-- Asking Lean whether a term of type `β` belongs to a `set α` is problematic
variable (b : β) -- UNCOMMENT next line to see full error
--#check (b ∈ A) -- failed to synthesize type class instance for... ⊢ has_mem β (set α)

/- This error message can be read as saying:
"I don't know how to make sense of the question of whether a term of type β
is a member of a set α"

(Trying to make sense of Infoview output is all part of learning Lean.) -/

/-
# New tactic: `change`

When we have a goal `⊢ H1` and we know that it is definitionally equal to `H2`
then we can do `change H2` and our goal changes to `⊢ H2`

It can also be used on local hypotheses: eg if we had
if `h : H1` then we could do `change H2 at h` to get `h : H2` -/

section mem
-- 04
example : 2 ∈ {n : ℕ | even n}:=
begin
  dsimp,    -- simplifies our goal to `⊢ even 2` which is definitionally the same.
  change ∃x, 2 = x + x, --if you check `even k` is defined to be `∃ x, k = x + x`
  use 1, -- provides the required `x` and then closes the remaining goal `2 = 1 + 1`
end

/-
You can check that both `dsimp` and `change` are not needed in our previous proof
(comment out the 1st two lines). They are still useful as we write the proof since they
help to clarify the goal. -/
-- 05
example : 2 ∈ ({1,2,3}: set ℕ):=
begin
  dsimp, -- goal becomes  `⊢ 3 = 1 ∨ 3 = 2 ∨ 3 = 3`
  right,left,refl,
end

-- 06
example : 3 ∈ {n:ℕ | n ≤ 10}  :=
begin
  sorry,
end

-- 07
example : 1 ∈ { x : ℕ | ∀ (k:ℕ), 1 ≤ k+1} :=
begin
  sorry,
end

--Not in `∉` is `\nin`
-- 08
example : x ∉ A ↔ ¬ (x ∈ A):=
begin
  refl,
end

-- 09
example : 4 ∉ {n : ℕ| 5 < n} ∧ 6 ∉ {n : ℕ | nat.prime n}:=
begin
  sorry,
end

end mem

section subsets

/-  `Subsets`: `⊆` (type \ss)
If `A B : set α` then `A ⊆ B` iff every element of A is also an element of B -/
-- 10
example : (A ⊆ B) ↔ (∀x, x ∈ A → x ∈ B):=
begin
  refl,
end

--the next proof is easy, but can you explain why `refl` works in this case?
-- 11
example (A : set α) : A ⊆ A:=
begin
  sorry,
end

/- If we have `(h : A ⊆ B)` and `(hx : x ∈ A)` then `h hx` is a proof that `x ∈ B`
So `h` takes a proof that `x ∈ A` and returns a proof that `x ∈ B`-/
-- 12
example (hx: x ∈ A)  (h: A ⊆ B) :  x ∈ B:=
begin
  apply h, -- Goal `⊢ x ∈ B` changes to `⊢ x ∈ A`
  exact hx,
end

-- Since `A ⊆ C` is `∀x, x ∈ A → x ∈ C` you can start with `intro x`,
-- 13
example  (hAB: A ⊆ B) (hBC: B ⊆ C) : A ⊆ C:=
begin
  sorry,
end

-- `dsimp at *` will simplify definitions in local context and in the goal.
-- 14
example : ({1,3} : set ℕ) ⊆ {n | n ≤ 5} :=
begin
  sorry,
end

end subsets

section ops

/- `Operations on sets`

We have all the usual methods of building new sets from old.

They are defined exactly as you would imagine.

Most of the next examples can be proved using `refl`

e.g. intersection `∩` (type \cap ) is `and` -/
-- 15
example : x ∈ A ∩ B ↔ (x ∈ A) ∧ (x ∈ B):=
begin
  refl,
end

-- union `∪` (type \un) is `or`
-- 16
example : x ∈ A ∪ B ↔ (x ∈ A) ∨ (x ∈ B):=
begin
  sorry,
end

-- Set `diff`erence `\` (type \\) is `(in A)  and (not in B)` (for `∉` type `\nin`)
-- 17
example : x ∈ A \ B ↔   x ∈ A ∧ x ∉ B :=
begin
  sorry,
end

-- Complement `ᶜ` (type \^c) is `not in`
-- 18
example : x ∈ Aᶜ ↔ ¬ (x ∈ A):=
begin
  sorry,
end

-- Complement and ∉ are the same
-- 19
example : x ∈ Aᶜ ↔ x ∉ A :=
begin
  sorry,
end

-- 20
example : A ∩ B ⊆ B:=
begin
  sorry,
end

-- 21
example : A ∩ B ⊆ B ∩ A :=
begin
  sorry,
end

-- 22
example  : A ∩ B ⊆ A ∪ B:=
begin
  sorry,
end

-- 23
example (hAB : A ⊆ B) (hCD: C ⊆ D) : A ∩ C ⊆ B ∩ D :=
begin
  sorry,
end

-- 24
example (hAB : A ∪ B ⊆ C) : A ⊆ C ∧ B ⊆ C:=
begin
  sorry,
end
end ops

section univ_empty
/-There are two special sets for any type α

     `univ = {a:α | true}`

     `∅ = {a:α | false}`

Note that `(univ : set α)` and `(∅ : set α)` so each type has
its own universal set and empty set. -/

-- open the namespace `set` to use univ otherwise we would have to use `set.univ`
open set
-- 25
example : x ∈ (univ : set α) ↔ true:=
begin
  refl,
end

--26
example  (A : set α) : A ⊆ A ∩ univ  :=
begin
  sorry,
end

/- Although `(univ : set α)` is the set containing every element of type `α`
   it is not equal to `α`, and Lean won't let you consider this -/

-- #check (univ : set α) = α
-- 27
example : x ∈ (∅ : set α) ↔ false:=
begin
  refl,
end

-- Note: if you have `h : x ∈ ∅` then `cases h` will let you consider all the cases..
-- 28
example (A : set α) : ∅ ∪  A ⊆ A   :=
begin
  sorry,
end
end univ_empty


def is_even (a : ℕ) := ∃ b, a = 2 * b

theorem even_plus_even {a b : ℕ} (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  match h1, h2 with
    ⟨w1, hw1⟩, ⟨w2, hw2⟩ := ⟨w1 + w2, by rw [hw1, hw2, mul_add]⟩
  end


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import geometry.euclidean.basic
import tactic.interval_cases

/-!
# Triangles

This file proves basic geometrical results about distances and angles
in (possibly degenerate) triangles in real inner product spaces and
Euclidean affine spaces.  More specialized results, and results
developed for simplices in general rather than just for triangles, are
in separate files.  Definitions and results that make sense in more
general affine spaces rather than just in the Euclidean case go under
`linear_algebra.affine_space`.

## Implementation notes

Results in this file are generally given in a form with only those
non-degeneracy conditions needed for the particular result, rather
than requiring affine independence of the points of a triangle
unnecessarily.

## References

* https://en.wikipedia.org/wiki/Pythagorean_theorem
* https://en.wikipedia.org/wiki/Law_of_cosines
* https://en.wikipedia.org/wiki/Pons_asinorum
* https://en.wikipedia.org/wiki/Sum_of_angles_of_a_triangle

-/

noncomputable theory
open_locale big_operators
open_locale classical
open_locale real
open_locale real_inner_product_space

namespace inner_product_geometry

/-!
### Geometrical results on triangles in real inner product spaces

This section develops some results on (possibly degenerate) triangles
in real inner product spaces, where those definitions and results can
most conveniently be developed in terms of vectors and then used to
deduce corresponding results for Euclidean affine spaces.
-/

variables {V : Type*} [inner_product_space ℝ V]

/-- Pythagorean theorem, if-and-only-if vector angle form. -/
lemma norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
  ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ ↔ angle x y = π / 2 :=
begin
  rw norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
end

/-- Pythagorean theorem, vector angle form. -/
lemma norm_add_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
  ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ :=
(norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h

/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
lemma norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
  ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ ↔ angle x y = π / 2 :=
begin
  rw norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
end

/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
lemma norm_sub_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
  ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ :=
(norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h

/-- Law of cosines (cosine rule), vector angle form. -/
lemma norm_sub_sq_eq_norm_sq_add_norm_sq_sub_two_mul_norm_mul_norm_mul_cos_angle
    (x y : V) :
  ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ - 2 * ∥x∥ * ∥y∥ * real.cos (angle x y) :=
by rw [(show 2 * ∥x∥ * ∥y∥ * real.cos (angle x y) =
             2 * (real.cos (angle x y) * (∥x∥ * ∥y∥)), by ring),
       cos_angle_mul_norm_mul_norm, ←real_inner_self_eq_norm_sq,
       ←real_inner_self_eq_norm_sq, ←real_inner_self_eq_norm_sq, real_inner_sub_sub_self,
       sub_add_eq_add_sub]

/-- Pons asinorum, vector angle form. -/
lemma angle_sub_eq_angle_sub_rev_of_norm_eq {x y : V} (h : ∥x∥ = ∥y∥) :
  angle x (x - y) = angle y (y - x) :=
begin
  refine real.inj_on_cos ⟨angle_nonneg _ _, angle_le_pi _ _⟩ ⟨angle_nonneg _ _, angle_le_pi _ _⟩ _,
  rw [cos_angle, cos_angle, h, ←neg_sub, norm_neg, neg_sub,
    inner_sub_right, inner_sub_right, real_inner_self_eq_norm_sq,
    real_inner_self_eq_norm_sq, h, real_inner_comm x y]
end

/-- Converse of pons asinorum, vector angle form. -/
lemma norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi {x y : V}
    (h : angle x (x - y) = angle y (y - x)) (hpi : angle x y ≠ π) : ∥x∥ = ∥y∥ :=
begin
  replace h := real.arccos_inj_on
    (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x (x - y)))
    (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one y (y - x))) h,
  by_cases hxy : x = y,
  { rw hxy },
  { rw [←norm_neg (y - x), neg_sub, mul_comm, mul_comm ∥y∥, div_eq_mul_inv, div_eq_mul_inv,
        mul_inv_rev', mul_inv_rev', ←mul_assoc, ←mul_assoc] at h,
    replace h :=
      mul_right_cancel' (inv_ne_zero (λ hz, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 hz)))) h,
    rw [inner_sub_right, inner_sub_right, real_inner_comm x y, real_inner_self_eq_norm_sq,
        real_inner_self_eq_norm_sq, mul_sub_right_distrib, mul_sub_right_distrib,
        mul_self_mul_inv, mul_self_mul_inv, sub_eq_sub_iff_sub_eq_sub,
        ←mul_sub_left_distrib] at h,
    by_cases hx0 : x = 0,
    { rw [hx0, norm_zero, inner_zero_left, zero_mul, zero_sub, neg_eq_zero] at h,
      rw [hx0, norm_zero, h] },
    { by_cases hy0 : y = 0,
      { rw [hy0, norm_zero, inner_zero_right, zero_mul, sub_zero] at h,
        rw [hy0, norm_zero, h] },
      { rw [inv_sub_inv (λ hz, hx0 (norm_eq_zero.1 hz)) (λ hz, hy0 (norm_eq_zero.1 hz)),
            ←neg_sub, ←mul_div_assoc, mul_comm, mul_div_assoc, ←mul_neg_one] at h,
        symmetry,
        by_contradiction hyx,
        replace h := (mul_left_cancel' (sub_ne_zero_of_ne hyx) h).symm,
        rw [real_inner_div_norm_mul_norm_eq_neg_one_iff, ←angle_eq_pi_iff] at h,
        exact hpi h } } }
end

/-- The cosine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.cos (angle x (x - y) + angle y (y - x)) = -real.cos (angle x y) :=
begin
  by_cases hxy : x = y,
  { rw [hxy, angle_self hy],
    simp },
  { rw [real.cos_add, cos_angle, cos_angle, cos_angle],
    have hxn : ∥x∥ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
    have hyn : ∥y∥ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
    have hxyn : ∥x - y∥ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
    apply mul_right_cancel' hxn,
    apply mul_right_cancel' hyn,
    apply mul_right_cancel' hxyn,
    apply mul_right_cancel' hxyn,
    have H1 : real.sin (angle x (x - y)) * real.sin (angle y (y - x)) *
                ∥x∥ * ∥y∥ * ∥x - y∥ * ∥x - y∥ =
              (real.sin (angle x (x - y)) * (∥x∥ * ∥x - y∥)) *
                (real.sin (angle y (y - x)) * (∥y∥ * ∥x - y∥)), { ring },
    have H2 : ⟪x, x⟫ * (inner x x - inner x y - (inner x y - inner y y)) -
                (inner x x - inner x y) * (inner x x - inner x y) =
              inner x x * inner y y - inner x y * inner x y, { ring },
    have H3 : ⟪y, y⟫ * (inner y y - inner x y - (inner x y - inner x x)) -
                (inner y y - inner x y) * (inner y y - inner x y) =
              inner x x * inner y y - inner x y * inner x y, { ring },
    rw [mul_sub_right_distrib, mul_sub_right_distrib, mul_sub_right_distrib,
        mul_sub_right_distrib, H1, sin_angle_mul_norm_mul_norm, norm_sub_rev x y,
        sin_angle_mul_norm_mul_norm, norm_sub_rev y x, inner_sub_left, inner_sub_left,
        inner_sub_right, inner_sub_right, inner_sub_right, inner_sub_right, real_inner_comm x y, H2,
        H3, real.mul_self_sqrt (sub_nonneg_of_le (real_inner_mul_inner_self_le x y)),
        real_inner_self_eq_norm_sq, real_inner_self_eq_norm_sq,
        real_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two],
    field_simp [hxn, hyn, hxyn],
    ring }
end

/-- The sine of the sum of two angles in a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma sin_angle_sub_add_angle_sub_rev_eq_sin_angle {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.sin (angle x (x - y) + angle y (y - x)) = real.sin (angle x y) :=
begin
  by_cases hxy : x = y,
  { rw [hxy, angle_self hy],
    simp },
  { rw [real.sin_add, cos_angle, cos_angle],
    have hxn : ∥x∥ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
    have hyn : ∥y∥ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
    have hxyn : ∥x - y∥ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
    apply mul_right_cancel' hxn,
    apply mul_right_cancel' hyn,
    apply mul_right_cancel' hxyn,
    apply mul_right_cancel' hxyn,
    have H1 : real.sin (angle x (x - y)) * (⟪y, y - x⟫ / (∥y∥ * ∥y - x∥)) * ∥x∥ * ∥y∥ * ∥x - y∥ =
                real.sin (angle x (x - y)) * (∥x∥ * ∥x - y∥) *
                  (⟪y, y - x⟫ / (∥y∥ * ∥y - x∥)) * ∥y∥, { ring },
    have H2 : ⟪x, x - y⟫ / (∥x∥ * ∥y - x∥) * real.sin (angle y (y - x)) * ∥x∥ * ∥y∥ * ∥y - x∥ =
                ⟪x, x - y⟫ / (∥x∥ * ∥y - x∥) *
                  (real.sin (angle y (y - x)) * (∥y∥ * ∥y - x∥)) * ∥x∥, { ring },
    have H3 : ⟪x, x⟫ * (⟪x, x⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪y, y⟫)) -
                (⟪x, x⟫ - ⟪x, y⟫) * (⟪x, x⟫ - ⟪x, y⟫) =
              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
    have H4 : ⟪y, y⟫ * (⟪y, y⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪x, x⟫)) -
                (⟪y, y⟫ - ⟪x, y⟫) * (⟪y, y⟫ - ⟪x, y⟫) =
              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫  * ⟪x, y⟫, { ring },
    rw [right_distrib, right_distrib, right_distrib, right_distrib, H1,
        sin_angle_mul_norm_mul_norm, norm_sub_rev x y, H2, sin_angle_mul_norm_mul_norm,
        norm_sub_rev y x, mul_assoc (real.sin (angle x y)), sin_angle_mul_norm_mul_norm,
        inner_sub_left, inner_sub_left, inner_sub_right, inner_sub_right, inner_sub_right,
        inner_sub_right, real_inner_comm x y, H3, H4, real_inner_self_eq_norm_sq,
        real_inner_self_eq_norm_sq,
        real_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two],
    field_simp [hxn, hyn, hxyn],
    ring }
end

/-- The cosine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma cos_angle_add_angle_sub_add_angle_sub_eq_neg_one {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.cos (angle x y + angle x (x - y) + angle y (y - x)) = -1 :=
by rw [add_assoc, real.cos_add, cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle hx hy,
       sin_angle_sub_add_angle_sub_rev_eq_sin_angle hx hy, ←neg_mul_eq_mul_neg, ←neg_add',
       add_comm, ←sq, ←sq, real.sin_sq_add_cos_sq]

/-- The sine of the sum of the angles of a possibly degenerate
triangle (where two given sides are nonzero), vector angle form. -/
lemma sin_angle_add_angle_sub_add_angle_sub_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  real.sin (angle x y + angle x (x - y) + angle y (y - x)) = 0 :=
begin
  rw [add_assoc, real.sin_add, cos_angle_sub_add_angle_sub_rev_eq_neg_cos_angle hx hy,
      sin_angle_sub_add_angle_sub_rev_eq_sin_angle hx hy],
  ring
end

/-- The sum of the angles of a possibly degenerate triangle (where the
two given sides are nonzero), vector angle form. -/
lemma angle_add_angle_sub_add_angle_sub_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  angle x y + angle x (x - y) + angle y (y - x) = π :=
begin
  have hcos := cos_angle_add_angle_sub_add_angle_sub_eq_neg_one hx hy,
  have hsin := sin_angle_add_angle_sub_add_angle_sub_eq_zero hx hy,
  rw real.sin_eq_zero_iff at hsin,
  cases hsin with n hn,
  symmetry' at hn,
  have h0 : 0 ≤ angle x y + angle x (x - y) + angle y (y - x) :=
    add_nonneg (add_nonneg (angle_nonneg _ _) (angle_nonneg _ _)) (angle_nonneg _ _),
  have h3 : angle x y + angle x (x - y) + angle y (y - x) ≤ π + π + π :=
    add_le_add (add_le_add (angle_le_pi _ _) (angle_le_pi _ _)) (angle_le_pi _ _),
  have h3lt : angle x y + angle x (x - y) + angle y (y - x) < π + π + π,
  { by_contradiction hnlt,
    have hxy : angle x y = π,
    { by_contradiction hxy,
      exact hnlt (add_lt_add_of_lt_of_le (add_lt_add_of_lt_of_le
                                           (lt_of_le_of_ne (angle_le_pi _ _) hxy)
                                         (angle_le_pi _ _)) (angle_le_pi _ _)) },
    rw hxy at hnlt,
    rw angle_eq_pi_iff at hxy,
    rcases hxy with ⟨hx, ⟨r, ⟨hr, hxr⟩⟩⟩,
    rw [hxr, ←one_smul ℝ x, ←mul_smul, mul_one, ←sub_smul, one_smul, sub_eq_add_neg,
        angle_smul_right_of_pos _ _ (add_pos zero_lt_one (neg_pos_of_neg hr)), angle_self hx,
        add_zero] at hnlt,
    apply hnlt,
    rw add_assoc,
    exact add_lt_add_left (lt_of_le_of_lt (angle_le_pi _ _)
                                          (lt_add_of_pos_right π real.pi_pos)) _ },
  have hn0 : 0 ≤ n,
  { rw [hn, mul_nonneg_iff_right_nonneg_of_pos real.pi_pos] at h0,
    norm_cast at h0,
    exact h0 },
  have hn3 : n < 3,
  { rw [hn, (show π + π + π = 3 * π, by ring)] at h3lt,
    replace h3lt := lt_of_mul_lt_mul_right h3lt (le_of_lt real.pi_pos),
    norm_cast at h3lt,
    exact h3lt },
  interval_cases n,
  { rw hn at hcos,
    simp at hcos,
    norm_num at hcos },
  { rw hn,
    norm_num },
  { rw hn at hcos,
    simp at hcos,
    norm_num at hcos },
end

end inner_product_geometry

namespace euclidean_geometry
/-!
### Geometrical results on triangles in Euclidean affine spaces

This section develops some geometrical definitions and results on
(possible degenerate) triangles in Euclidean affine spaces.
-/
open inner_product_geometry

open_locale euclidean_geometry

variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
    [normed_add_torsor V P]
include V

/-- Pythagorean theorem, if-and-only-if angle-at-point form. -/
lemma dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two (p1 p2 p3 : P) :
  dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔
    ∠ p1 p2 p3 = π / 2 :=
by erw [pseudo_metric_space.dist_comm p3 p2, dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2,
        dist_eq_norm_vsub V p2 p3,
        ←norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two,
        vsub_sub_vsub_cancel_right p1, ←neg_vsub_eq_vsub_rev p2 p3, norm_neg]

/-- Law of cosines (cosine rule), angle-at-point form. -/
lemma dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle
    (p1 p2 p3 : P) :
  dist p1 p3 * dist p1 p3 =
    dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 -
      2 * dist p1 p2 * dist p3 p2 * real.cos (∠ p1 p2 p3) :=
begin
  rw [dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2, dist_eq_norm_vsub V p3 p2],
  unfold angle,
  convert norm_sub_sq_eq_norm_sq_add_norm_sq_sub_two_mul_norm_mul_norm_mul_cos_angle
          (p1 -ᵥ p2 : V) (p3 -ᵥ p2 : V),
  { exact (vsub_sub_vsub_cancel_right p1 p3 p2).symm },
  { exact (vsub_sub_vsub_cancel_right p1 p3 p2).symm }
end

/-- Pons asinorum, angle-at-point form. -/
lemma angle_eq_angle_of_dist_eq {p1 p2 p3 : P} (h : dist p1 p2 = dist p1 p3) :
  ∠ p1 p2 p3 = ∠ p1 p3 p2 :=
begin
  rw [dist_eq_norm_vsub V p1 p2, dist_eq_norm_vsub V p1 p3] at h,
  unfold angle,
  convert angle_sub_eq_angle_sub_rev_of_norm_eq h,
  { exact (vsub_sub_vsub_cancel_left p3 p2 p1).symm },
  { exact (vsub_sub_vsub_cancel_left p2 p3 p1).symm }
end

/-- Converse of pons asinorum, angle-at-point form. -/
lemma dist_eq_of_angle_eq_angle_of_angle_ne_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = ∠ p1 p3 p2)
    (hpi : ∠ p2 p1 p3 ≠ π) : dist p1 p2 = dist p1 p3 :=
begin
  unfold angle at h hpi,
  rw [dist_eq_norm_vsub V p1 p2, dist_eq_norm_vsub V p1 p3],
  rw [←angle_neg_neg, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] at hpi,
  rw [←vsub_sub_vsub_cancel_left p3 p2 p1, ←vsub_sub_vsub_cancel_left p2 p3 p1] at h,
  exact norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi h hpi
end

/-- The sum of the angles of a possibly degenerate triangle (where the
given vertex is distinct from the others), angle-at-point. -/
lemma angle_add_angle_add_angle_eq_pi {p1 p2 p3 : P} (h2 : p2 ≠ p1) (h3 : p3 ≠ p1) :
  ∠ p1 p2 p3 + ∠ p2 p3 p1 + ∠ p3 p1 p2 = π :=
begin
  rw [add_assoc, add_comm, add_comm (∠ p2 p3 p1), angle_comm p2 p3 p1],
  unfold angle,
  rw [←angle_neg_neg (p1 -ᵥ p3), ←angle_neg_neg (p1 -ᵥ p2), neg_vsub_eq_vsub_rev,
      neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev,
      ←vsub_sub_vsub_cancel_right p3 p2 p1, ←vsub_sub_vsub_cancel_right p2 p3 p1],
  exact angle_add_angle_sub_add_angle_sub_eq_pi (λ he, h3 (vsub_eq_zero_iff_eq.1 he))
                                                (λ he, h2 (vsub_eq_zero_iff_eq.1 he))
end

end euclidean_geometry


import data.polynomial
import data.real.basic
import algebra.big_operators

noncomputable theory
open_locale big_operators

open polynomial

-- The basic building block in the Lagrange polynomial
-- this is (x - b)/(a - b)
def scaled_binomial (a b : ℝ) : polynomial ℝ :=
((1 : ℝ) / (a - b)) • (X - C b)

@[simp] lemma scaled_binomial.def (a b : ℝ) :
  scaled_binomial a b = ((1 : ℝ) / (a - b)) • (X - C b) := rfl

lemma bin_zero (a b : ℝ) : eval b (scaled_binomial a b) = 0 :=
by rw [scaled_binomial.def, eval_smul, eval_sub, eval_X, eval_C, sub_self, smul_eq_mul, mul_zero]

lemma bin_one (a b : ℝ) (h : a ≠ b) : eval a (scaled_binomial a b) = 1 :=
by rw [scaled_binomial.def, eval_smul, eval_sub, eval_X, eval_C, smul_eq_mul,
      div_mul_cancel 1 (sub_ne_zero_of_ne h)]

-- This version, using scalar multiplication (`smul`) seems simplest.
-- Must add hypothesis that data points are distinct
def lagrange_interpolant (n : ℕ) (i : ℕ) (xData : ℕ → ℝ) : polynomial ℝ :=
∏ j in (finset.range (n+1)).erase i, scaled_binomial (xData i) (xData j)

-- This has been PR'd into mathlib as `eval_prod`
lemma eval_finset.prod {ι : Type*} (s : finset ι) (p : ι → polynomial ℝ) (x : ℝ) :
  eval x (∏ j in s, p j) = ∏ j in s, eval x (p j) :=
(finset.prod_hom _ _).symm

-- The equivalent of the above for sums
lemma eval_finset.sum {ι : Type*} (s : finset ι) (p : ι → polynomial ℝ) (x : ℝ) :
  eval x (∑ j in s, p j) = ∑ j in s, eval x (p j) :=
(finset.sum_hom _ _).symm

-- The Lagrange interpolant `Lᵢ x` is one for `x = xData i`
@[simp]
lemma lagrange_interpolant_one (n : ℕ) (xData : ℕ → ℝ) (i : ℕ)
  (hinj : function.injective xData) :
  eval (xData i) (lagrange_interpolant n i xData) = (1:ℝ) :=
begin
  unfold lagrange_interpolant,
  rw eval_finset.prod,
  --simp only [bin_one], -- simp fails because the simplifier can't derive `a ≠ b`
  exact finset.prod_eq_one (λ j hj, bin_one (xData i) (xData j)
    (mt (@hinj i j) (finset.ne_of_mem_erase hj).symm))
end