import game.max.level08 -- hide

open_locale classical -- hide

noncomputable theory -- hide

namespace xena -- hide

/-
# Chapter 4 : Max

## Level 9

We've done `max_le_iff`; here is `le_max_iff`.
-/

/- Lemma
If $a$, $b$, $c$ are real numbers,
then $a\leq\max(b,c)$ iff ($a\leq b$ or $a\leq c$).
-/

theorem le_max_iff {a b c : ℝ} : a ≤ max b c ↔ a ≤ b ∨ a ≤ c :=
begin
  split,
  intro h,
  cases le_total b c with hbc hcb,
  rw max_eq_right at h,
  right,
  exact h,
  exact hbc,
  rw max_eq_left at h,
  left,
  exact h,
  exact hcb,
  intro j,
  cases j with d hd,
  apply le_trans d,
  apply le_max_left,
  apply le_trans hd,
  apply le_max_right,

end

end xena --hide


/-
Copyright (c) 2023 Tian Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tian Chen
-/

import ineq.matrix
import ineq.fin

open_locale big_operators

open finset

variables {α : Type*} [linear_ordered_field α] [@decidable_rel α (≤)] [@decidable_rel α (<)]

theorem exists_doubly_stochastic' {n : ℕ} {p q : fin n → α}
  (hp : antitone p) (hq : antitone q)
  (hpq₁ : ∑ i, p i = ∑ i, q i)
  (hpq₂ : ∀ i, (((univ.val.map q).sort (≥)).take i).sum ≤
    (((univ.val.map p).sort (≥)).take i).sum) :
  ∃ M : matrix (fin n) (fin n) α, M.doubly_stochastic ∧ q = M.mul_vec p :=
begin
  induction ht : (univ.filter (λ i, p i ≠ q i)).card
    using nat.strong_induction_on with t h_ind generalizing p,
  by_cases ht0 : t = 0,
  { rw [ht0, card_eq_zero, filter_eq_empty_iff] at ht,
    use 1,
    rw matrix.one_mul_vec,
    refine ⟨matrix.doubly_stochastic_one, _⟩,
    ext,
    rw not_not.1 (ht _ (mem_univ _)) },
  rw ← ht at h_ind ht0,
  have hpq : p ≠ q,
  { rintro rfl,
    apply ht0,
    rw [card_eq_zero, filter_eq_empty_iff],
    intros,
    rw not_not },
  simp_rw [hp.sort_eq_of_fn, hq.sort_eq_of_fn] at hpq₂,
  obtain ⟨p', hp', hp'₁, hp'₂, h_card, M', hM'₁, hM'₂⟩ := exists_fn_lt p q hpq hp hq hpq₁ hpq₂,
  specialize h_ind _ h_card hp' (hp'₁.trans hpq₁),
  simp_rw [hp'.sort_eq_of_fn, hq.sort_eq_of_fn] at h_ind,
  obtain ⟨M, hM₁, hM₂⟩ := h_ind (λ _, (hp'₂ _).1) rfl,
  use [M.mul M'],
  refine ⟨hM₁.mul hM'₁, _⟩,
  rw [hM₂, hM'₂, matrix.mul_vec_mul_vec]
end

variables {ι : Type*} [fintype ι] [decidable_eq ι]

variables (l : ι → α)

noncomputable def sort_equiv :=
  (tuple.sort (λ i, order_dual.to_dual $ l ((fintype.equiv_fin ι).symm i))).trans
  (fintype.equiv_fin ι).symm

lemma comp_sort_equiv_eq_sort_desc : l ∘ sort_equiv l = sort_desc l :=
begin
  have : monotone (order_dual.to_dual ∘ l ∘ (sort_equiv l)) :=
    tuple.monotone_sort (order_dual.to_dual ∘ l ∘ (fintype.equiv_fin ι).symm),
  rw [← list.of_fn_inj, of_fn_sort_desc],
  refine list.eq_of_perm_of_sorted _
    (list.monotone_iff_of_fn_sorted.1 this) (multiset.sort_sorted _ _),
  rw [← multiset.coe_eq_coe, multiset.sort_eq, ← list.map_of_fn, ← multiset.coe_map],
  congr,
  ext i,
  rw [multiset.count_univ, multiset.coe_count, list.count_eq_one_of_mem],
  exact list.nodup_of_fn_of_injective (equiv.injective _),
  rw [list.mem_of_fn, function.surjective.range_eq (equiv.surjective _)],
  apply set.mem_univ
end

lemma sort_equiv_to_matrix_mul_vec :
  (sort_equiv l).to_pequiv.to_matrix.mul_vec l = sort_desc l :=
begin
  ext i,
  rw [← comp_sort_equiv_eq_sort_desc, sort_equiv],
  rw [equiv.to_pequiv_trans, pequiv.to_matrix_trans, pequiv.to_pequiv_mul_matrix,
    equiv.to_pequiv_symm, pequiv.to_matrix_symm, matrix.mul_vec, matrix.dot_product],
  simp_rw [matrix.transpose_apply, pequiv.to_matrix, equiv.to_pequiv_apply,
    option.mem_some_iff, boole_mul, ← equiv.eq_symm_apply],
  rw [sum_ite_eq', if_pos (mem_univ _)],
  refl
end

lemma vec_mul_sort_equiv_to_matrix :
  (sort_equiv l).to_pequiv.to_matrix.vec_mul (sort_desc l) = l :=
by rw [← sort_equiv_to_matrix_mul_vec, matrix.vec_mul_mul_vec, ← pequiv.to_matrix_symm,
  ← equiv.to_pequiv_symm, ← pequiv.to_matrix_trans, ← equiv.to_pequiv_trans,
  equiv.symm_trans_self, equiv.to_pequiv_refl, pequiv.to_matrix_refl, matrix.vec_mul_one]

/-- If `p` majorizes `q`, there exists a doubly stochastic matrix `M` such that `q = M p` -/
theorem majorize.exists_doubly_stochastic {p q : ι → α} (hpq : majorize q p) :
  ∃ M : matrix ι ι α, M.doubly_stochastic ∧ q = M.mul_vec p :=
begin
  rw ← sort_desc_majorize_iff q p at hpq,
  have hp := sort_desc_antitone p,
  have hq := sort_desc_antitone q,
  rw antitone.majorize hq hp at hpq,
  simp_rw [of_fn_sort_desc, ← map_sort_desc p, ← map_sort_desc q] at hpq,
  obtain ⟨M, hM, hM'⟩ := exists_doubly_stochastic' hp hq hpq.2.symm hpq.1,
  use [(sort_equiv q).symm.to_pequiv.to_matrix.mul (M.mul (sort_equiv p).to_pequiv.to_matrix),
    ((sort_equiv q).symm.doubly_stochastic α).mul
      (hM.mul ((sort_equiv p).doubly_stochastic α))],
  rw [← matrix.mul_vec_mul_vec, ← matrix.mul_vec_mul_vec, sort_equiv_to_matrix_mul_vec,
    ← hM', equiv.to_pequiv_symm, pequiv.to_matrix_symm, matrix.mul_vec_transpose,
    vec_mul_sort_equiv_to_matrix]
end


import data.set.basic
import lib.attempt

open set

def equivalence_class {X : Type} (R : X → X → Prop) (x : X) := {y : X | R x y}

theorem challenge06 (X : Type) (R : X → X → Prop) (hR : equivalence R) (x : X) : equivalence_class R x ≠ ∅ :=
attempt begin
  intro h,
  replace h := congr_fun h x,
  have r := hR.1 x,
  replace h : R x x = false := h,
  rw h at r,
  exact r
end $
attempt (λ h, (congr_fun h x).mp $ hR.1 x) $
attempt begin
  apply nonempty.ne_empty,
  use x,
  exact hR.1 x
end $
nonempty.ne_empty ⟨x, hR.1 x⟩


--import data.set
import tactic

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object

-- dEAduction definitions
import set_definitions

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement (since it will be called with 'rw' or 'symp_rw')

---------------------
-- Course metadata --
---------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists', 'equal', 'map']
-- proofs names ['use_proof_methods', 'new_object']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'sorry']
-- magic names ['compute', 'assumption']

/- dEAduction
Title
    Exercices de mathématiques discretes
Author
    Alice Laroche
Institution
    Sorbonne Université
Description
    Exercices d'un cours de maths discrètes à Sorbonne Université.
    Les numéros de questions font référence à la feuille de TD.
-/

namespace set

-- def disjoint {X : Type} (A B : set X) : Prop := A ∩ B = ∅

def partition {X :Type} (A : set (set X)) := (∀A₁ ∈ A , A₁ ≠ ∅) ∧ (∀A₁ A₂ ∈ A, (A₁ ∩ A₂ = ∅) ∨ A₁ = A₂) ∧ (∀x, ∃A₁ ∈ A, x ∈ A₁)

end set

namespace relation

def inv {X Y : Type} (R : set (X × Y)) : set (Y × X)
| (x, y) := (y, x) ∈ R

def product {X Y Z : Type} (R : set (X × Y)) (R' : set (Y × Z)) : set (X × Z)
| (x, y) := ∃z, (x, z) ∈ R ∧ (z, y) ∈ R'

def identite {X: Type} : set (X × X)
| (x, y) := x = y

def reflexive {X : Type} (R : set (X × X)) := ∀x, (x, x) ∈ R

def transitive {X : Type} (R: set (X × X)) := ∀x y z, (x, y) ∈ R ∧ (y, z) ∈ R → (x, z) ∈ R

def symetrique {X : Type} (R : set (X × X)) := ∀x y, (x, y) ∈ R → (y, x) ∈ R

def antisymetrique {X : Type} (R : set (X × X)) := ∀x y, (x, y) ∈ R ∧ (y, x) ∈ R → x = y

def relation_equivalence {X : Type} (R : set (X × X)) := reflexive R ∧ transitive R ∧ symetrique R

def relation_ordre {X : Type} (R : set (X × X)) := reflexive R ∧ transitive R ∧ antisymetrique R

def classe_equivalence {X : Type} (R : set (X × X)) (h1 : relation_equivalence R) (e : X) : set X
| e' :=  (e, e')  ∈ R

def deterministe {X Y : Type} (R : set (X × Y)) := ∀x y z, (x, y) ∈ R ∧ (x, z) ∈ R → y = z

def total_gauche {X Y : Type} (R : set (X × Y)) := ∀x, ∃y, (x, y) ∈ R

def application {X Y : Type} (R : set (X × Y)) := deterministe R ∧ total_gauche R

def injective {X Y : Type} (R : set (X × Y)) := ∀x y z, (x, z) ∈ R ∧ (y, z) ∈ R → x = y

def surjective {X Y : Type} (R : set (X × Y)) := ∀y, ∃x, (x, y) ∈ R

def application_injective {X Y : Type} (R : set (X × Y)) := application R ∧ injective R

def application_surjective {X Y : Type} (R : set (X × Y)) := application R ∧ surjective R

def application_bijective {X Y : Type} (R : set (X × Y)) := application R ∧ injective R ∧ surjective R

def image {X Y : Type} (R : set (X × Y)) (x : X) (y : Y) := (x, y) ∈ R

end relation

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
parameters {X Y Z: Type}

open set
open relation

notation [parsing_only] R `.` S := relation.product R S

notation R `⁻¹`  := relation.inv R
notation R `dot` S := relation.product R S

------------------
-- COURSE TITLE --
------------------
namespace math_discretes
/- dEAduction
PrettyName
    Mathématiques discrètes
-/

namespace generalites
/- dEAduction
PrettyName
    Généralités
-/

------------------------
-- COURSE DEFINITIONS --
------------------------
lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
/- dEAduction
PrettyName
    Inclusion
ImplicitUse
    True
-/
begin
    todo,
end

lemma definition.egalite_deux_ensembles {A A' : set X} :
(A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles
ImplicitUse
    True
-/
begin
    exact set.ext_iff,
end

-- lemma definition.inegalite_deux_ensembles {A A' : set X} :
-- (A ≠ A') ↔ ( ∃x, (x ∈ A ∧ x ∉ A') ∨ (x ∈ A' ∧ x ∉ A)) :=
-- /- dEAduction
-- PrettyName
--     Inégalité de deux ensembles
-- -/
-- begin
--     todo,
-- end

lemma definition.ensemble_vide
(A: set X) :
(A = ∅) ↔ ∀ x : X, x ∉ A
:=
begin
    exact eq_empty_iff_forall_not_mem,
end

lemma definition.ensemble_extension {X: Type}  {P : X → Prop} {x:X} :
 x ∈ {x | P x} ↔ P x
:=
/- dEAduction
PrettyName
    Ensemble en extension
-/
begin
    refl,
end

lemma definition.singleton {X : Type} {x y : X} : x ∈ ({y} : set X) ↔ x = y
:=
/- dEAduction
PrettyName
    Singleton
-/
begin
    exact mem_singleton_iff,
end

lemma definition.double_inclusion (A A' : set X) :
A = A' ↔ (A ⊆ A' ∧ A' ⊆ A) :=
/- dEAduction
PrettyName
    Double inclusion
ImplicitUse
    True
-/
begin
    exact set.subset.antisymm_iff,
end

lemma definition.ensemble_partie (A A' : set X) :
A' ∈ 𝒫(A) ↔  A' ⊆ A
:=
/- dEAduction
PrettyName
    Ensemble des parties
-/
begin
    refl,
end

end generalites

namespace union_intersection
/- dEAduction
PrettyName
    Unions et intersections
-/

------------------------
-- COURSE DEFINITIONS --
------------------------

lemma definition.intersection_deux_ensembles {A B : set X} {x : X} :
x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
/- dEAduction
PrettyName
    Intersection de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl,
end

lemma definition.union_deux_ensembles {A B : set X} {x : X} :
x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
/- dEAduction
PrettyName
    Union de deux ensembles
ImplicitUse
    True
-/
begin
    exact iff.rfl,
end

lemma definition.partition
 {P : set (set X)} :
 partition P ↔ (∀A₁ ∈ P , A₁ ≠ ∅) ∧ (∀A₁ A₂ ∈ P, (A₁ ∩ A₂ = ∅) ∨ A₁ = A₂) ∧ (∀x, ∃A₁ ∈ P, x ∈ A₁)
:=
/- dEAduction
PrettyName
   Partition
-/
begin
    todo
end
-- lemma definition.intersection_videI (A : set X) :
-- A ∩ ∅ = ∅ :=
-- /- dEAduction
-- PrettyName
--     Intersection avec l'ensemble vide I
-- ImplicitUse
--     False
-- -/
-- begin
--     exact inter_empty A,
-- end

-- lemma definition.intersection_videII (A : set X) :
-- ∅ ∩ A = ∅ :=
-- /- dEAduction
-- PrettyName
--     Intersection avec l'ensemble vide II
-- ImplicitUse
--     False
-- -/
-- begin
--     exact empty_inter A,
-- end

-- lemma definition.union_deux_ensembles  {A : set X} {B : set X} {x : X} :
-- x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
-- /- dEAduction
-- PrettyName
--     Union de deux ensembles
-- ImplicitUse
--     True
-- -/
-- begin
--     exact iff.rfl,
-- end

-- lemma definition.union_intersection (A B C : set X) :
-- A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C) :=
-- /- dEAduction
-- PrettyName
--    Union avec une intersection
-- ImplicitUse
--     False
-- -/
-- begin
--   exact set.union_distrib_left A B C,
-- end

-- lemma definition.union_videI (A : set X) :
-- A ∪ ∅ = A :=
-- /- dEAduction
-- PrettyName
--     Union avec l'ensemble vide I
-- ImplicitUse
--     False
-- -/
-- begin
--     exact union_empty A,
-- end

-- lemma definition.union_videII (A : set X) :
-- ∅ ∪ A = A :=
-- /- dEAduction
-- PrettyName
--     Union avec l'ensemble vide II
-- ImplicitUse
--     False
-- -/
-- begin
--     exact empty_union A,
-- end

end union_intersection

namespace complementaire
/- dEAduction
PrettyName
    Complémentaire
-/

------------------------
-- COURSE DEFINITIONS --
------------------------

lemma definition.complement {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
/- dEAduction
PrettyName
    Complementaire
-/
begin
    finish,
end

lemma definition.difference {A A' : set X} {x : X} : x ∈ set.diff A A' ↔ x ∈ A ∧ x ∉ A' :=
/- dEAduction
PrettyName
    Différence
ImplicitUse
    False
-/
begin
    finish,
end
-- lemma definition.complement_complement {A : set X} : (set.compl (set.compl A)) = A :=
-- /- dEAduction
-- PrettyName
--     Complementaire du complementaire
-- ImplicitUse
--     False
-- -/
-- begin
--     exact compl_compl',
-- end

-- lemma definition.complement_intersection {A B : set X} :
-- set.compl (A ∩ B) = (set.compl A) ∪ (set.compl B) :=
-- /- dEAduction
-- PrettyName
--     Complementaire d'une intersection
-- ImplicitUse
--     False
-- -/
-- begin
--     exact compl_inter A B,
-- end

-- lemma definition.intersection_complement {A : set X} :
-- A ∩ set.compl (A) = ∅ :=
-- /- dEAduction
-- PrettyName
--     Intersection avec le complémentaire
-- ImplicitUse
--     False
-- -/
-- begin
--     exact inter_compl_self A,
-- end

-- lemma definition.complement_union {A B : set X} :
-- set.compl (A ∪ B) = (set.compl A) ∩ (set.compl B) :=
-- /- dEAduction
-- PrettyName
--     Complementaire d'une union
-- ImplicitUse
--     False
-- -/
-- begin
--     exact compl_union A B,
-- end

-- lemma definition.union_complement {A : set X} :
-- A ∪ set.compl (A) = univ :=
-- /- dEAduction
-- PrettyName
--     Union avec le complémentaire
-- ImplicitUse
--     False
-- -/
-- begin
--     exact union_compl_self A,
-- end

end complementaire

namespace produits_cartesiens
/- dEAduction
PrettyName
    Produits cartésiens
-/

-- lemma definition.type_produit :
-- ∀ z:X × Y, ∃ x:X, ∃ y:Y, z = (x,y) :=
-- /- dEAduction
-- PrettyName
--     Element d'un produit cartésien de deux ensembles
-- -/
-- begin
--     todo
-- end

lemma definition.produit_de_parties {A : set X} {B : set Y} {x:X} {y:Y} :
(x,y) ∈ set.prod A B ↔ x ∈ A ∧ y ∈ B :=
/- dEAduction
PrettyName
    Produit cartésien de deux parties
-/
begin
    todo
end

end produits_cartesiens

namespace relations
/- dEAduction
PrettyName
    Relations
-/

------------------------
-- COURSE DEFINITIONS --
------------------------

lemma definition.inv {R : set (X × Y)} {x : X} {y : Y} :
(y,x) ∈ (inv R) ↔ (x,y) ∈ R :=
/- dEAduction
PrettyName
    Inverse d'une relation
-/
begin
    refl,
end

lemma definition.prod {R : set (X × Y)} {S : set (Y × Z)} {x : X} {z : Z} :
(x,z) ∈ (product R S) ↔ ∃y, (x,y) ∈ R ∧ (y,z) ∈ S :=
/- dEAduction
PrettyName
    Produit de deux relations
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.id {x : X} {y : X} :
(x,y) ∈ (identite : set (X × X))  ↔ x = y :=
/- dEAduction
PrettyName
    Relation identité
-/
begin
    refl,
end

lemma theorem.id :
∀ x:X,  (x,x) ∈ (identite : set (X × X)) :=
/- dEAduction
PrettyName
    Relation identité
-/
begin
    intro x, rw definition.id,
end

lemma definition.reflexive {R : set (X × X)} :
reflexive R ↔ ∀x, (x, x) ∈ R :=
/- dEAduction
PrettyName
    Réflexivité
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.transitive {R : set (X × X)} :
transitive R ↔ ∀x y z, (x, y) ∈ R ∧ (y, z) ∈ R → (x, z) ∈ R :=
/- dEAduction
PrettyName
    Transitivité
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.symetrique {R : set (X × X)} :
symetrique R ↔ ∀x y, (x, y) ∈ R → (y, x) ∈ R:=
/- dEAduction
PrettyName
    Symétrie
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.antisymetrique {R : set (X × X)} :
antisymetrique R ↔ ∀x y, (x, y) ∈ R ∧ (y, x) ∈ R → x = y :=
/- dEAduction
PrettyName
    Antisymétrie
-/
begin
    refl,
end

lemma definition.equivalence {R : set (X × X)} :
relation_equivalence R ↔ reflexive R ∧ transitive R ∧ symetrique R :=
/- dEAduction
PrettyName
    Relation d'équivalence
ImplicitUse
    True
-/
begin
    refl,
end

lemma definition.ordre {R : set (X × X)} :
relation_ordre R ↔ reflexive R ∧ transitive R ∧ antisymetrique R :=
/- dEAduction
PrettyName
    Relation d'ordre
-/
begin
    refl,
end

lemma definition.classe_equivalence {x y : X} {R : set (X × X)} {h1 : relation_equivalence R}:
y ∈ classe_equivalence R h1 x ↔ (x, y) ∈ R :=
/- dEAduction
PrettyName
    Classe d'équivalence
-/
begin
    refl,
end
end relations

-- namespace applications

-- lemma definition.deterministe {X Y : Type} (R : set (X × Y))
-- : deterministe R ↔ ∀x y z, (x, y) ∈ R ∧ (x, z) ∈ R → y = z :=
-- /- dEAduction
-- PrettyName
--     Relation déterministe
-- -/
-- begin
--     refl,
-- end

-- lemma definition.total_gauche {X Y : Type} (R : set (X × Y)) :
-- total_gauche R ↔ ∀x, ∃y, (x, y) ∈ R :=
-- /- dEAduction
-- PrettyName
--     Relation totale
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application {X Y : Type} (R : set (X × Y)) :
-- application R ↔ deterministe R ∧ total_gauche R :=
-- /- dEAduction
-- PrettyName
--      Relation et application
-- -/
-- begin
--     refl,
-- end

-- lemma definition.relation_injective {X Y : Type} (R : set (X × Y)) :
-- relation.injective R ↔ ∀x y z, (x, z) ∈ R ∧ (y, z) ∈ R → x = y :=
-- /- dEAduction
-- PrettyName
--     Relation injective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.relation_surjective {X Y : Type} (R : set (X × Y)) :
-- relation.surjective R ↔ ∀y, ∃x, (x, y) ∈ R :=
-- /- dEAduction
-- PrettyName
--     Relation surjective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application_injective {X Y : Type} (R : set (X × Y)) :
-- application_injective R ↔ application R ∧ relation.injective R :=
-- /- dEAduction
-- PrettyName
--     Application injective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application_surjective {X Y : Type} (R : set (X × Y)) :
-- application_surjective R ↔ application R ∧ relation.surjective R :=
-- /- dEAduction
-- PrettyName
--     Application surjective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.application_bijective {X Y : Type} (R : set (X × Y)) :
-- application_bijective R ↔ application R ∧ relation.injective R ∧ relation.surjective R :=
-- /- dEAduction
-- PrettyName
--     Application bijective
-- -/
-- begin
--     refl,
-- end

-- lemma definition.image {X Y : Type} (R : set (X × Y)) (x : X) (y : Y) :
-- image R x y ↔ (x, y) ∈ R :=
-- /- dEAduction
-- PrettyName
--     Image d'une relation
-- -/
-- begin
--     refl,
-- end

-- end applications

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

variables  {A B C : set X}

lemma exercise.facile :
B ⊆ A ∪ B  :=
/- dEAduction
PrettyName
    L'union contient l'ensemble
-/
begin
    todo,
end

lemma exercise.complement_complement : ∀ A: set X, set.compl (set.compl A) = A :=
/- dEAduction
PrettyName
    Complementaire du complémentaire
-/
begin
    todo
end

namespace exercice2
/- dEAduction
PrettyName
    Exercice 2
-/

lemma exercise.question1 :
(A ∩ compl (A ∩ B)) = (A ∩ compl B) :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question2 :
A ∩ B = A ∩ C → A ∩ compl B = A ∩ compl C :=
/- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end

lemma exercise.question3 :
A ∩ B = A ∩ C ↔ A ∩ (compl B) = A ∩ (compl C) :=
/- dEAduction
PrettyName
    Question 3
Description
    Deduire de la question précedente l'équivalence des deux énoncés.
-/
begin
    todo,
end

lemma exercise.question4 :
A ∪ B ⊆ A ∪ C ∧ A ∩ B ⊆ A ∩ C → B ⊆ C :=
/- dEAduction
PrettyName
    Question 4
-/
begin
    todo,
end

lemma exercise.question5 :
set.prod A (B ∪ C) = set.prod A B ∪ set.prod A C :=
/- dEAduction
PrettyName
    Question 5
-/
begin
    todo,
end

-- lemma exercise.question61 :
-- 𝒫(A ∪ B) = 𝒫(A) ∪ 𝒫(B) ∨ ¬𝒫(A ∪ B) = 𝒫(A) ∪ 𝒫(B) :=
-- /- dEAduction
-- PrettyName
--     Question 6.1
-- OpenQuestion
--     True
-- -/
-- begin
--     todo,
-- end

lemma exercise.question62 :
𝒫(A ∩ B) = 𝒫(A) ∩ 𝒫(B) :=
/- dEAduction
PrettyName
    Question 6.2
-/
begin
    todo,
end

--𝒫(E ∪ {x}) = 𝒫(E) ∪ {A' | ∃A ∈ 𝒫(E), A' = A ∪ {x}} :=
lemma exercise.question7 (F : Type) (E : set F) (x : F) (h : x ∉ E) :
𝒫(E ∪ {x}) = 𝒫(E) ∪ {A' | ∃A ⊆ E, A' = A ∪ {x}} :=
/- dEAduction
PrettyName
    Question 7
-/
begin
    todo
end

end exercice2

namespace exercice5
/- dEAduction
PrettyName
    Exercice 5
-/

lemma exercise.question2_produit_inverse (X Y Z : Type) (R : set (X × Y)) (S : set (Y × Z)) :
 (R dot S) ⁻¹ = ((S ⁻¹) dot (R ⁻¹)) :=
 /- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end
end exercice5

namespace exercice6
/- dEAduction
PrettyName
    Exercice 6
-/

lemma exercise.question1 (X: Type) (R : set (X × X)) :
reflexive R ↔ identite ⊆ R :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question2 (X: Type) (R : set (X × X)) :
symetrique R ↔ R = inv R  :=
/- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end

lemma exercise.question3 (X: Type) (R : set (X × X)) :
antisymetrique R ↔ (R ∩ (inv R)) ⊆ identite :=
/- dEAduction
PrettyName
    Question 3
-/
begin
    todo,
end

lemma exercise.question4 (X: Type) (R : set (X × X)) :
transitive R ↔ (product R R) ⊆ R :=
/- dEAduction
PrettyName
    Question 4
-/
begin
    todo,
end

lemma exercise.question5 (X: Type) (R : set (X × X)) :
reflexive R → R ⊆ (R dot R) ∧ reflexive (R dot R) :=
/- dEAduction
PrettyName
    Question 5
-/
begin
    todo,
end

lemma exercise.question6 (X: Type) (R : set (X × X)) :
symetrique R → (R ⁻¹ dot R) = (R dot R ⁻¹) :=
/- dEAduction
PrettyName
    Question 6
-/
begin
    todo,
end

lemma exercise.question7 (X: Type) (R : set (X × X)) :
transitive R → transitive (R dot R) :=
/- dEAduction
PrettyName
    Question 7
-/
begin
    todo,
end
end exercice6

namespace exercice8
/- dEAduction
PrettyName
    Exercice 8
-/

lemma exercise.question1 (A : Type) (R : set (A × A)) (h1 : relation_equivalence R) :
∀a, a ∈ classe_equivalence R h1 a :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question2 (A : Type) (R : set (A × A)) (h1 : relation_equivalence R) (a b : A) :
classe_equivalence R h1 a = classe_equivalence R h1 b ↔ (a,b) ∈ R :=
/- dEAduction
PrettyName
    Question 2
-/
begin
    todo,
end

lemma exercise.question3 (A : Type) (R : set (A × A)) (h1 : relation_equivalence R) (a b : A) :
classe_equivalence R h1 a ≠ classe_equivalence R h1 b → classe_equivalence R h1 a ∩ classe_equivalence R h1 b = ∅ :=
/- dEAduction
PrettyName
    Question 3
-/
begin
    todo,
end

lemma exercise.question5 (A : Type) (R : set (A × A)) (h1 : relation_equivalence R) :
partition {A₁ | ∃x, A₁ = classe_equivalence R h1 x} :=
/- dEAduction
PrettyName
    Question 5
-/
begin
    todo,
end

end exercice8

-- namespace exercice15
-- /- dEAduction
-- PrettyName
--     Exercice 15
-- -/

-- -- TODO: intégrer les defs pour applications (composition, id, bijective)
-- lemma exercise.question (X : Type) (f : X → X) :
-- ((composition f f) = id : X → X) → bijective f:=
-- /- dEAduction
-- PrettyName
--     Question 1
-- -/
-- begin
--     todo,
-- end
-- end exercice15

namespace exercice22
/- dEAduction
PrettyName
    Exercice 22
-/

lemma exercise.question22_1 (X Y : Type) (f : X → Y) (R : set (X × X)) (H1 : ∀x x', (x, x') ∈ R ↔ f x = f x') :
relation_equivalence R :=
/- dEAduction
PrettyName
    Question 1
-/
begin
    todo,
end

lemma exercise.question3 (X Y : Type) (f : X → Y) (R : set (X × X)) (H1 : ∀x x', (x, x') ∈ R ↔ f x = f x')
(H2: relation_equivalence R) :
∀x y, x ∈ classe_equivalence R H2 y → classe_equivalence R H2 x = classe_equivalence R H2 y :=
/- dEAduction
PrettyName
    Question 3
-/
begin
    todo,
end

-- lemma exercise.question41 (E F : Type) (f : set (E × F)) (h1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (S : set (E × (set E))) (h6 : ∀x y, relation.image S x y ↔ y = classe_equivalence Rf h3 x) :
-- relation.injective S ∨ ¬relation.injective S :=
-- /- dEAduction
-- PrettyName
--     ** Question 4.1
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question42 (E F : Type) (f : set (E × F)) (h1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (S : set (E × (set E))) (h6 : ∀x y, relation.image S x y ↔ y = classe_equivalence Rf h3 x) :
-- relation.surjective S ∨ ¬relation.surjective S :=
-- /- dEAduction
-- PrettyName
--     ** Question 4.2
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question5 (E F : Type) (f : set (E × F)) (h1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (f' : set ((set E) × F)) (h6 : ∀X y, (X, y) ∈ f' ↔ ∃x ∈ X, relation.image f x y) :
-- application f' :=
-- /- dEAduction
-- PrettyName
--     ** Question 5
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question61 (E F : Type) (f : set (E × F)) (h1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (f' : set ((set E) × F)) (h6 : ∀X y, (X, y) ∈ f' ↔ ∃x ∈ X, relation.image f x y) :
-- relation.injective f' ∨ ¬ relation.injective f' :=
-- /- dEAduction
-- PrettyName
--     ** Question 6.1
-- -/
-- begin
--     todo,
-- end

-- lemma exercise.question62 (E F : Type) (f : set (E × F)) (h1 : application f)
-- (Rf : set (E × E)) (h2 : ∀x y, (x,y) ∈ Rf ↔ (∃z, image f x z ∧ image f y z)) (h3 : relation_equivalence Rf)
-- (h4 : ¬relation.injective Rf) (h5 : ¬relation.surjective Rf)
-- (f' : set ((set E) × F)) (h6 : ∀X y, (X, y) ∈ f' ↔ ∃x ∈ X, relation.image f x y) :
-- relation.injective f' ∨ ¬ relation.injective f' :=
-- /- dEAduction
-- PrettyName
--     ** Question 6.2
-- -/
-- begin
--     todo,
-- end

end exercice22

end exercices

end math_discretes
end course


/-
Copyright (c) 2020 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.computation.correctness_terminating
import data.nat.fib
import tactic.solve_by_elim
/-!
# Approximations for Continued Fraction Computations (`generalized_continued_fraction.of`)

## Summary

This file contains useful approximations for the values involved in the continued fractions
computation `generalized_continued_fraction.of`. In particular, we derive the so-called
*determinant formula* for `generalized_continued_fraction.of`:
`Aₙ * Bₙ₊₁ - Bₙ * Aₙ₊₁ = (-1)^(n + 1)`.

Moreover, we derive some upper bounds for the error term when computing a continued fraction up a
given position, i.e. bounds for the term
`|v - (generalized_continued_fraction.of v).convergents n|`. The derived bounds will show us that
the error term indeed gets smaller. As a corollary, we will be able to show that
`(generalized_continued_fraction.of v).convergents` converges to `v` in
`algebra.continued_fractions.computation.approximation_corollaries`.

## Main Theorems

- `generalized_continued_fraction.of_part_num_eq_one`: shows that all partial numerators `aᵢ` are
  equal to one.
- `generalized_continued_fraction.exists_int_eq_of_part_denom`: shows that all partial denominators
  `bᵢ` correspond to an integer.
- `generalized_continued_fraction.one_le_of_nth_part_denom`: shows that `1 ≤ bᵢ`.
- `generalized_continued_fraction.succ_nth_fib_le_of_nth_denom`: shows that the `n`th denominator
  `Bₙ` is greater than or equal to the `n + 1`th fibonacci number `nat.fib (n + 1)`.
- `generalized_continued_fraction.le_of_succ_nth_denom`: shows that `bₙ * Bₙ ≤ Bₙ₊₁`, where `bₙ` is
  the `n`th partial denominator of the continued fraction.
- `generalized_continued_fraction.abs_sub_convergents_le`: shows that
  `|v - Aₙ / Bₙ| ≤ 1 / (Bₙ * Bₙ₊₁)`, where `Aₙ` is the nth partial numerator.

## References

- [*Hardy, GH and Wright, EM and Heath-Brown, Roger and Silverman, Joseph*][hardy2008introduction]
- https://en.wikipedia.org/wiki/Generalized_continued_fraction#The_determinant_formula

-/

namespace generalized_continued_fraction
open generalized_continued_fraction (of) int

variables {K : Type*} {v : K} {n : ℕ} [linear_ordered_field K] [floor_ring K]

namespace int_fract_pair
/-!
We begin with some lemmas about the stream of `int_fract_pair`s, which presumably are not
of great interest for the end user.
-/

/-- Shows that the fractional parts of the stream are in `[0,1)`. -/
lemma nth_stream_fr_nonneg_lt_one {ifp_n : int_fract_pair K}
  (nth_stream_eq : int_fract_pair.stream v n = some ifp_n) :
  0 ≤ ifp_n.fr ∧ ifp_n.fr < 1 :=
begin
  cases n,
  case nat.zero
  { have : int_fract_pair.of v = ifp_n, by injection nth_stream_eq,
    rw [←this, int_fract_pair.of],
    exact ⟨fract_nonneg _, fract_lt_one _⟩ },
  case nat.succ
  { rcases (succ_nth_stream_eq_some_iff.elim_left nth_stream_eq) with ⟨_, _, _, ifp_of_eq_ifp_n⟩,
    rw [←ifp_of_eq_ifp_n, int_fract_pair.of],
    exact ⟨fract_nonneg _, fract_lt_one _⟩ }
end

/-- Shows that the fractional parts of the stream are nonnegative. -/
lemma nth_stream_fr_nonneg {ifp_n : int_fract_pair K}
  (nth_stream_eq : int_fract_pair.stream v n = some ifp_n) :
  0 ≤ ifp_n.fr :=
(nth_stream_fr_nonneg_lt_one nth_stream_eq).left

/-- Shows that the fractional parts of the stream are smaller than one. -/
lemma nth_stream_fr_lt_one {ifp_n : int_fract_pair K}
  (nth_stream_eq : int_fract_pair.stream v n = some ifp_n) :
  ifp_n.fr < 1 :=
(nth_stream_fr_nonneg_lt_one nth_stream_eq).right

/-- Shows that the integer parts of the stream are at least one. -/
lemma one_le_succ_nth_stream_b {ifp_succ_n : int_fract_pair K}
  (succ_nth_stream_eq : int_fract_pair.stream v (n + 1) = some ifp_succ_n) :
  1 ≤ ifp_succ_n.b :=
begin
  obtain ⟨ifp_n, nth_stream_eq, stream_nth_fr_ne_zero, ⟨-⟩⟩ :
    ∃ ifp_n, int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr ≠ 0
    ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n, from
      succ_nth_stream_eq_some_iff.elim_left succ_nth_stream_eq,
  suffices : 1 ≤ ifp_n.fr⁻¹, { rw_mod_cast [le_floor], assumption },
  suffices : ifp_n.fr ≤ 1,
  { have h : 0 < ifp_n.fr, from
      lt_of_le_of_ne (nth_stream_fr_nonneg nth_stream_eq) stream_nth_fr_ne_zero.symm,
    apply one_le_inv h this },
  simp only [le_of_lt (nth_stream_fr_lt_one nth_stream_eq)]
end

/--
Shows that the `n + 1`th integer part `bₙ₊₁` of the stream is smaller or equal than the inverse of
the `n`th fractional part `frₙ` of the stream.
This result is straight-forward as `bₙ₊₁` is defined as the floor of `1 / frₙ`
-/
lemma succ_nth_stream_b_le_nth_stream_fr_inv {ifp_n ifp_succ_n : int_fract_pair K}
  (nth_stream_eq : int_fract_pair.stream v n = some ifp_n)
  (succ_nth_stream_eq : int_fract_pair.stream v (n + 1) = some ifp_succ_n) :
  (ifp_succ_n.b : K) ≤ ifp_n.fr⁻¹ :=
begin
  suffices : (⌊ifp_n.fr⁻¹⌋ : K) ≤ ifp_n.fr⁻¹,
  { cases ifp_n with _ ifp_n_fr,
    have : ifp_n_fr ≠ 0,
    { intro h, simpa [h, int_fract_pair.stream, nth_stream_eq] using succ_nth_stream_eq },
    have : int_fract_pair.of ifp_n_fr⁻¹ = ifp_succ_n,
    { simpa [this, int_fract_pair.stream, nth_stream_eq, option.coe_def] using succ_nth_stream_eq },
    rwa ←this },
  exact (floor_le ifp_n.fr⁻¹)
end

end int_fract_pair

/-!
Next we translate above results about the stream of `int_fract_pair`s to the computed continued
fraction `generalized_continued_fraction.of`.
-/

/-- Shows that the integer parts of the continued fraction are at least one. -/
lemma of_one_le_nth_part_denom {b : K}
  (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) :
  1 ≤ b :=
begin
  obtain ⟨gp_n,  nth_s_eq, ⟨-⟩⟩ : ∃ gp_n, (of v).s.nth n = some gp_n ∧ gp_n.b = b, from
    exists_s_b_of_part_denom nth_part_denom_eq,
  obtain ⟨ifp_n, succ_nth_stream_eq, ifp_n_b_eq_gp_n_b⟩ :
    ∃ ifp, int_fract_pair.stream v (n + 1) = some ifp ∧ (ifp.b : K) = gp_n.b, from
      int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some nth_s_eq,
  rw [←ifp_n_b_eq_gp_n_b],
  exact_mod_cast (int_fract_pair.one_le_succ_nth_stream_b succ_nth_stream_eq)
end

/--
Shows that the partial numerators `aᵢ` of the continued fraction are equal to one and the partial
denominators `bᵢ` correspond to integers.
-/
lemma of_part_num_eq_one_and_exists_int_part_denom_eq {gp : generalized_continued_fraction.pair K}
  (nth_s_eq : (of v).s.nth n = some gp) :
  gp.a = 1 ∧ ∃ (z : ℤ), gp.b = (z : K) :=
begin
  obtain ⟨ifp, stream_succ_nth_eq, -⟩ :
    ∃ ifp, int_fract_pair.stream v (n + 1) = some ifp ∧ _,
      from int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some nth_s_eq,
  have : gp = ⟨1, ifp.b⟩, by
  { have : (of v).s.nth n = some ⟨1, ifp.b⟩, from
      nth_of_eq_some_of_succ_nth_int_fract_pair_stream stream_succ_nth_eq,
    have : some gp = some ⟨1, ifp.b⟩, by rwa nth_s_eq at this,
    injection this },
  simp [this],
end

/-- Shows that the partial numerators `aᵢ` are equal to one. -/
lemma of_part_num_eq_one {a : K} (nth_part_num_eq : (of v).partial_numerators.nth n = some a) :
  a = 1 :=
begin
  obtain ⟨gp, nth_s_eq, gp_a_eq_a_n⟩ : ∃ gp, (of v).s.nth n = some gp ∧ gp.a = a, from
    exists_s_a_of_part_num nth_part_num_eq,
  have : gp.a = 1, from (of_part_num_eq_one_and_exists_int_part_denom_eq nth_s_eq).left,
  rwa gp_a_eq_a_n at this
end

/-- Shows that the partial denominators `bᵢ` correspond to an integer. -/
lemma exists_int_eq_of_part_denom {b : K}
  (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) :
  ∃ (z : ℤ), b = (z : K) :=
begin
  obtain ⟨gp, nth_s_eq, gp_b_eq_b_n⟩ : ∃ gp, (of v).s.nth n = some gp ∧ gp.b = b, from
    exists_s_b_of_part_denom nth_part_denom_eq,
  have : ∃ (z : ℤ), gp.b = (z : K), from
    (of_part_num_eq_one_and_exists_int_part_denom_eq nth_s_eq).right,
  rwa gp_b_eq_b_n at this
end

/-!
One of our next goals is to show that `bₙ * Bₙ ≤ Bₙ₊₁`. For this, we first show that the partial
denominators `Bₙ` are bounded from below by the fibonacci sequence `nat.fib`. This then implies that
`0 ≤ Bₙ` and hence `Bₙ₊₂ = bₙ₊₁ * Bₙ₊₁ + Bₙ ≥ bₙ₊₁ * Bₙ₊₁ + 0 = bₙ₊₁ * Bₙ₊₁`.
-/

-- open `nat` as we will make use of fibonacci numbers.
open nat

lemma fib_le_of_continuants_aux_b : (n ≤ 1 ∨ ¬(of v).terminated_at (n - 2)) →
  (fib n : K) ≤ ((of v).continuants_aux n).b :=
nat.strong_induction_on n
begin
  clear n,
  assume n IH hyp,
  rcases n with _|_|n,
  { simp [fib_add_two, continuants_aux] }, -- case n = 0
  { simp [fib_add_two, continuants_aux] }, -- case n = 1
  { let g := of v,  -- case 2 ≤ n
    have : ¬(n + 2 ≤ 1), by linarith,
    have not_terminated_at_n : ¬g.terminated_at n, from or.resolve_left hyp this,
    obtain ⟨gp, s_ppred_nth_eq⟩ : ∃ gp, g.s.nth n = some gp, from
      option.ne_none_iff_exists'.mp not_terminated_at_n,
    set pconts := g.continuants_aux (n + 1) with pconts_eq,
    set ppconts := g.continuants_aux n with ppconts_eq,
    -- use the recurrence of continuants_aux
    suffices : (fib n : K) + fib (n + 1) ≤ gp.a * ppconts.b + gp.b * pconts.b, by
      simpa [fib_add_two, add_comm,
        (continuants_aux_recurrence s_ppred_nth_eq ppconts_eq pconts_eq)],
    -- make use of the fact that gp.a = 1
    suffices : (fib n : K) + fib (n + 1) ≤ ppconts.b + gp.b * pconts.b, by
      simpa [(of_part_num_eq_one $ part_num_eq_s_a s_ppred_nth_eq)],
    have not_terminated_at_pred_n : ¬g.terminated_at (n - 1), from
      mt (terminated_stable $ nat.sub_le n 1) not_terminated_at_n,
    have not_terminated_at_ppred_n : ¬terminated_at g (n - 2), from
      mt (terminated_stable (n - 1).pred_le) not_terminated_at_pred_n,
    -- use the IH to get the inequalities for `pconts` and `ppconts`
    have : (fib (n + 1) : K) ≤ pconts.b, from
      IH _ (nat.lt.base $ n + 1) (or.inr not_terminated_at_pred_n),
    have ppred_nth_fib_le_ppconts_B : (fib n : K) ≤ ppconts.b, from
      IH n (lt_trans (nat.lt.base n) $ nat.lt.base $ n + 1) (or.inr not_terminated_at_ppred_n),
    suffices : (fib (n + 1) : K) ≤ gp.b * pconts.b,
      solve_by_elim [add_le_add ppred_nth_fib_le_ppconts_B],
    -- finally use the fact that 1 ≤ gp.b to solve the goal
    suffices : 1 * (fib (n + 1) : K) ≤ gp.b * pconts.b, by rwa [one_mul] at this,
    have one_le_gp_b : (1 : K) ≤ gp.b, from
      of_one_le_nth_part_denom (part_denom_eq_s_b s_ppred_nth_eq),
    have : (0 : K) ≤ fib (n + 1), by exact_mod_cast (fib (n + 1)).zero_le,
    have : (0 : K) ≤ gp.b, from le_trans zero_le_one one_le_gp_b,
    mono }
end

/-- Shows that the `n`th denominator is greater than or equal to the `n + 1`th fibonacci number,
that is `nat.fib (n + 1) ≤ Bₙ`. -/
lemma succ_nth_fib_le_of_nth_denom (hyp: n = 0 ∨ ¬(of v).terminated_at (n - 1)) :
  (fib (n + 1) : K) ≤ (of v).denominators n :=
begin
  rw [denom_eq_conts_b, nth_cont_eq_succ_nth_cont_aux],
  have : (n + 1) ≤ 1 ∨ ¬(of v).terminated_at (n - 1), by
  { cases n,
    case nat.zero : { exact (or.inl $ le_refl 1) },
    case nat.succ : { exact or.inr (or.resolve_left hyp n.succ_ne_zero) } },
  exact (fib_le_of_continuants_aux_b this)
end

/-! As a simple consequence, we can now derive that all denominators are nonnegative. -/

lemma zero_le_of_continuants_aux_b : 0 ≤ ((of v).continuants_aux n).b :=
begin
  let g := of v,
  induction n with n IH,
  case nat.zero: { refl },
  case nat.succ:
  { cases (decidable.em $ g.terminated_at (n - 1)) with terminated not_terminated,
    { cases n, -- terminating case
      { simp [zero_le_one] },
      { have : g.continuants_aux (n + 2) = g.continuants_aux (n + 1), from
          continuants_aux_stable_step_of_terminated terminated,
        simp only [this, IH] } },
    { calc -- non-terminating case
      (0 : K) ≤ fib (n + 1)                        : by exact_mod_cast (n + 1).fib.zero_le
          ... ≤ ((of v).continuants_aux (n + 1)).b : fib_le_of_continuants_aux_b
                                                       (or.inr not_terminated) } }
end

/-- Shows that all denominators are nonnegative. -/
lemma zero_le_of_denom : 0 ≤ (of v).denominators n :=
by { rw [denom_eq_conts_b, nth_cont_eq_succ_nth_cont_aux], exact zero_le_of_continuants_aux_b }

lemma le_of_succ_succ_nth_continuants_aux_b {b : K}
  (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) :
  b * ((of v).continuants_aux $ n + 1).b ≤ ((of v).continuants_aux $ n + 2).b :=
begin
  obtain ⟨gp_n, nth_s_eq, rfl⟩ : ∃ gp_n, (of v).s.nth n = some gp_n ∧ gp_n.b = b,
    from exists_s_b_of_part_denom nth_part_denom_eq,
  simp [of_part_num_eq_one (part_num_eq_s_a nth_s_eq), zero_le_of_continuants_aux_b,
     generalized_continued_fraction.continuants_aux_recurrence nth_s_eq rfl rfl]
end

/-- Shows that `bₙ * Bₙ ≤ Bₙ₊₁`, where `bₙ` is the `n`th partial denominator and `Bₙ₊₁` and `Bₙ` are
the `n + 1`th and `n`th denominator of the continued fraction. -/
theorem le_of_succ_nth_denom {b : K}
  (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) :
  b * (of v).denominators n ≤ (of v).denominators (n + 1) :=
begin
  rw [denom_eq_conts_b, nth_cont_eq_succ_nth_cont_aux],
  exact (le_of_succ_succ_nth_continuants_aux_b nth_part_denom_eq)
end

/-- Shows that the sequence of denominators is monotone, that is `Bₙ ≤ Bₙ₊₁`. -/
theorem of_denom_mono : (of v).denominators n ≤ (of v).denominators (n + 1) :=
begin
  let g := of v,
  cases (decidable.em $ g.partial_denominators.terminated_at n) with terminated not_terminated,
  { have : g.partial_denominators.nth n = none, by rwa stream.seq.terminated_at at terminated,
    have : g.terminated_at n, from
      terminated_at_iff_part_denom_none.elim_right (by rwa stream.seq.terminated_at at terminated),
    have : g.denominators (n + 1) = g.denominators n, from
      denominators_stable_of_terminated n.le_succ this,
    rw this },
  { obtain ⟨b, nth_part_denom_eq⟩ : ∃ b, g.partial_denominators.nth n = some b, from
      option.ne_none_iff_exists'.mp not_terminated,
    have : 1 ≤ b, from of_one_le_nth_part_denom nth_part_denom_eq,
    calc g.denominators n
        ≤ b * g.denominators n   : by simpa using (mul_le_mul_of_nonneg_right this zero_le_of_denom)
    ... ≤ g.denominators (n + 1) : le_of_succ_nth_denom nth_part_denom_eq }
end

section determinant
/-!
### Determinant Formula

Next we prove the so-called *determinant formula* for `generalized_continued_fraction.of`:
`Aₙ * Bₙ₊₁ - Bₙ * Aₙ₊₁ = (-1)^(n + 1)`.
-/

lemma determinant_aux (hyp: n = 0 ∨ ¬(of v).terminated_at (n - 1)) :
    ((of v).continuants_aux n).a * ((of v).continuants_aux (n + 1)).b
    - ((of v).continuants_aux n).b * ((of v).continuants_aux (n + 1)).a
  = (-1)^n :=
begin
  induction n with n IH,
  case nat.zero { simp [continuants_aux] },
  case nat.succ
  { -- set up some shorthand notation
    let g := of v,
    let conts := continuants_aux g (n + 2),
    set pred_conts := continuants_aux g (n + 1) with pred_conts_eq,
    set ppred_conts := continuants_aux g n with ppred_conts_eq,
    let pA := pred_conts.a,
    let pB := pred_conts.b,
    let ppA := ppred_conts.a,
    let ppB := ppred_conts.b,
    -- let's change the goal to something more readable
    change pA * conts.b - pB * conts.a = (-1)^(n + 1),
    have not_terminated_at_n : ¬terminated_at g n, from or.resolve_left hyp n.succ_ne_zero,
    obtain ⟨gp, s_nth_eq⟩ : ∃ gp, g.s.nth n = some gp, from
      option.ne_none_iff_exists'.elim_left not_terminated_at_n,
    -- unfold the recurrence relation for `conts` once and simplify to derive the following
    suffices : pA * (ppB + gp.b * pB) - pB * (ppA + gp.b * pA) = (-1)^(n + 1), by
    { simp only [conts, (continuants_aux_recurrence s_nth_eq ppred_conts_eq pred_conts_eq)],
      have gp_a_eq_one : gp.a = 1, from of_part_num_eq_one (part_num_eq_s_a s_nth_eq),
      rw [gp_a_eq_one, this.symm],
      ring },
    suffices : pA * ppB - pB * ppA = (-1)^(n + 1), calc
      pA * (ppB + gp.b * pB) - pB * (ppA + gp.b * pA)
          = pA * ppB + pA * gp.b * pB - pB * ppA - pB * gp.b * pA : by ring
      ... = pA * ppB - pB * ppA                                   : by ring
      ... = (-1)^(n + 1)                                          : by assumption,
    suffices : ppA * pB - ppB * pA = (-1)^n, by
    { have pow_succ_n : (-1 : K)^(n + 1) = (-1) * (-1)^n, from pow_succ (-1) n,
      rw [pow_succ_n, ←this],
      ring },
    exact (IH $ or.inr $ mt (terminated_stable $ n.sub_le 1) not_terminated_at_n) }
end

/-- The determinant formula `Aₙ * Bₙ₊₁ - Bₙ * Aₙ₊₁ = (-1)^(n + 1)` -/
lemma determinant (not_terminated_at_n : ¬(of v).terminated_at n) :
    (of v).numerators n * (of v).denominators (n + 1)
    - (of v).denominators n * (of v).numerators (n + 1)
  = (-1)^(n + 1) :=
(determinant_aux $ or.inr $ not_terminated_at_n)

end determinant

section error_term
/-!
### Approximation of Error Term

Next we derive some approximations for the error term when computing a continued fraction up a given
position, i.e. bounds for the term `|v - (generalized_continued_fraction.of v).convergents n|`.
-/

/-- This lemma follows from the finite correctness proof, the determinant equality, and
by simplifying the difference. -/
lemma sub_convergents_eq {ifp : int_fract_pair K}
  (stream_nth_eq : int_fract_pair.stream v n = some ifp) :
  let g := of v in
  let B := (g.continuants_aux (n + 1)).b in
  let pB := (g.continuants_aux n).b in
  v - g.convergents n = if ifp.fr = 0 then 0 else (-1)^n / (B * (ifp.fr⁻¹ * B + pB)) :=
begin
  -- set up some shorthand notation
  let g := of v,
  let conts := g.continuants_aux (n + 1),
  let pred_conts := g.continuants_aux n,
  have g_finite_correctness :
    v = generalized_continued_fraction.comp_exact_value pred_conts conts ifp.fr, from
    comp_exact_value_correctness_of_stream_eq_some stream_nth_eq,
  cases decidable.em (ifp.fr = 0) with ifp_fr_eq_zero ifp_fr_ne_zero,
  { suffices : v - g.convergents n = 0, by simpa [ifp_fr_eq_zero],
    replace g_finite_correctness : v = g.convergents n, by
      simpa [generalized_continued_fraction.comp_exact_value, ifp_fr_eq_zero]
        using g_finite_correctness,
    exact (sub_eq_zero.elim_right g_finite_correctness) },
  { -- more shorthand notation
    let A := conts.a,
    let B := conts.b,
    let pA := pred_conts.a,
    let pB := pred_conts.b,
    -- first, let's simplify the goal as `ifp.fr ≠ 0`
    suffices : v - A / B = (-1)^n / (B * (ifp.fr⁻¹ * B + pB)), by simpa [ifp_fr_ne_zero],
    -- now we can unfold `g.comp_exact_value` to derive the following equality for `v`
    replace g_finite_correctness : v = (pA + ifp.fr⁻¹ * A) / (pB + ifp.fr⁻¹ * B), by
      simpa [generalized_continued_fraction.comp_exact_value, ifp_fr_ne_zero, next_continuants,
        next_numerator, next_denominator, add_comm] using g_finite_correctness,
    -- let's rewrite this equality for `v` in our goal
    suffices : (pA + ifp.fr⁻¹ * A) / (pB + ifp.fr⁻¹ * B) - A / B
             = (-1)^n / (B * (ifp.fr⁻¹ * B + pB)), by rwa g_finite_correctness,
    -- To continue, we need use the determinant equality. So let's derive the needed hypothesis.
    have n_eq_zero_or_not_terminated_at_pred_n : n = 0 ∨ ¬g.terminated_at (n - 1), by
    { cases n with n',
      { simp },
      { have : int_fract_pair.stream v (n' + 1) ≠ none, by simp [stream_nth_eq],
        have : ¬g.terminated_at n', from
          (not_iff_not_of_iff of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none)
          .elim_right this,
        exact (or.inr this) } },
    have determinant_eq : pA * B - pB * A = (-1)^n, from
      determinant_aux n_eq_zero_or_not_terminated_at_pred_n,
    -- now all we got to do is to rewrite this equality in our goal and re-arrange terms;
    -- however, for this, we first have to derive quite a few tedious inequalities.
    have pB_ineq : (fib n : K) ≤ pB, by
    { have : n ≤ 1 ∨ ¬g.terminated_at (n - 2), by
      { cases n_eq_zero_or_not_terminated_at_pred_n with n_eq_zero not_terminated_at_pred_n,
        { simp [n_eq_zero] },
        { exact (or.inr $ mt (terminated_stable (n - 1).pred_le) not_terminated_at_pred_n) } },
      exact (fib_le_of_continuants_aux_b this) },
    have B_ineq : (fib (n + 1) : K) ≤ B, by
    { have : n + 1 ≤ 1 ∨ ¬g.terminated_at (n + 1 - 2), by
      { cases n_eq_zero_or_not_terminated_at_pred_n with n_eq_zero not_terminated_at_pred_n,
        { simp [n_eq_zero, le_refl] },
        { exact (or.inr not_terminated_at_pred_n) } },
      exact (fib_le_of_continuants_aux_b this) },
    have zero_lt_B : 0 < B,
    { have : 1 ≤ B, from
        le_trans
        (by exact_mod_cast fib_pos (lt_of_le_of_ne n.succ.zero_le n.succ_ne_zero.symm)) B_ineq,
      exact (lt_of_lt_of_le zero_lt_one this) },
    have zero_ne_B : 0 ≠ B, from ne_of_lt zero_lt_B,
    have : 0 ≠ pB + ifp.fr⁻¹ * B, by
    { have : (0 : K) ≤ fib n, by exact_mod_cast (fib n).zero_le,
      -- 0 ≤ fib n ≤ pB
      have zero_le_pB : 0 ≤ pB, from le_trans this pB_ineq,
      have : 0 < ifp.fr⁻¹, by
      { suffices : 0 < ifp.fr, by rwa inv_pos,
        have : 0 ≤ ifp.fr, from int_fract_pair.nth_stream_fr_nonneg stream_nth_eq,
        change ifp.fr ≠ 0 at ifp_fr_ne_zero,
        exact lt_of_le_of_ne this ifp_fr_ne_zero.symm },
      have : 0 < ifp.fr⁻¹ * B, from mul_pos this zero_lt_B,
      have : 0 < pB + ifp.fr⁻¹ * B, from add_pos_of_nonneg_of_pos zero_le_pB this,
      exact (ne_of_lt this) },
    -- finally, let's do the rewriting
    calc
      (pA + ifp.fr⁻¹ * A) / (pB + ifp.fr⁻¹ * B) - A / B
          = ((pA + ifp.fr⁻¹ * A) * B - (pB + ifp.fr⁻¹ * B) * A)
            / ((pB + ifp.fr⁻¹ * B) * B)                             : by rw (div_sub_div _ _
                                                                           this.symm zero_ne_B.symm)
      ... = (pA * B + ifp.fr⁻¹ * A * B - (pB * A + ifp.fr⁻¹ * B * A))
            / _                                                     : by repeat { rw [add_mul] }
      ... = (pA * B - pB * A) / ((pB + ifp.fr⁻¹ * B) * B)           : by ring
      ... = (-1)^n / ((pB + ifp.fr⁻¹ * B) * B)                      : by rw determinant_eq
      ... = (-1)^n / (B * (ifp.fr⁻¹ * B + pB))                      : by ac_refl }
end

/-- Shows that `|v - Aₙ / Bₙ| ≤ 1 / (Bₙ * Bₙ₊₁)` -/
theorem abs_sub_convergents_le (not_terminated_at_n : ¬(of v).terminated_at n) :
    |v - (of v).convergents n|
  ≤ 1 / (((of v).denominators n) * ((of v).denominators $ n + 1)) :=
begin
  -- shorthand notation
  let g := of v,
  let nextConts := g.continuants_aux (n + 2),
  set conts := continuants_aux g (n + 1) with conts_eq,
  set pred_conts := continuants_aux g n with pred_conts_eq,
  -- change the goal to something more readable
  change |v - convergents g n| ≤ 1 / (conts.b * nextConts.b),
  obtain ⟨gp, s_nth_eq⟩ : ∃ gp, g.s.nth n = some gp, from
    option.ne_none_iff_exists'.elim_left not_terminated_at_n,
  have gp_a_eq_one : gp.a = 1, from of_part_num_eq_one (part_num_eq_s_a s_nth_eq),
  -- unfold the recurrence relation for `nextConts.b`
  have nextConts_b_eq : nextConts.b = pred_conts.b + gp.b * conts.b, by
    simp [nextConts, (continuants_aux_recurrence s_nth_eq pred_conts_eq conts_eq), gp_a_eq_one,
      pred_conts_eq.symm, conts_eq.symm, add_comm],
  let denom := conts.b * (pred_conts.b + gp.b * conts.b),
  suffices : |v - g.convergents n| ≤ 1 / denom, by { rw [nextConts_b_eq], congr' 1 },
  obtain ⟨ifp_succ_n, succ_nth_stream_eq, ifp_succ_n_b_eq_gp_b⟩ :
    ∃ ifp_succ_n, int_fract_pair.stream v (n + 1)
                = some ifp_succ_n ∧ (ifp_succ_n.b : K) = gp.b, from
      int_fract_pair.exists_succ_nth_stream_of_gcf_of_nth_eq_some s_nth_eq,
  obtain ⟨ifp_n, stream_nth_eq, stream_nth_fr_ne_zero, if_of_eq_ifp_succ_n⟩ :
    ∃ ifp_n, int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr ≠ 0
           ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n, from
      int_fract_pair.succ_nth_stream_eq_some_iff.elim_left succ_nth_stream_eq,
  let denom' := conts.b * (pred_conts.b + ifp_n.fr⁻¹ * conts.b),
  -- now we can use `sub_convergents_eq` to simplify our goal
  suffices : |(-1)^n / denom'| ≤ 1 / denom, by
  { have : v - g.convergents n = (-1)^n / denom', by
    { -- apply `sub_convergens_eq` and simplify the result
      have tmp, from sub_convergents_eq stream_nth_eq,
      delta at tmp,
      simp only [stream_nth_fr_ne_zero, conts_eq.symm, pred_conts_eq.symm] at tmp,
      rw tmp,
      simp only [denom'],
      ring_nf },
    rwa this },
  -- derive some tedious inequalities that we need to rewrite our goal
  have nextConts_b_ineq : (fib (n + 2) : K) ≤ (pred_conts.b + gp.b * conts.b), by
  { have : (fib (n + 2) : K) ≤ nextConts.b, from
      fib_le_of_continuants_aux_b (or.inr not_terminated_at_n),
    rwa [nextConts_b_eq] at this },
  have conts_b_ineq : (fib (n + 1) : K) ≤ conts.b, by
  { have : ¬g.terminated_at (n - 1), from mt (terminated_stable n.pred_le) not_terminated_at_n,
    exact (fib_le_of_continuants_aux_b $ or.inr this) },
  have zero_lt_conts_b : 0 < conts.b, by
  { have : (0 : K) < fib (n + 1), by
      exact_mod_cast (fib_pos (lt_of_le_of_ne n.succ.zero_le n.succ_ne_zero.symm)),
    exact (lt_of_lt_of_le this conts_b_ineq) },
  -- `denom'` is positive, so we can remove `|⬝|` from our goal
  suffices : 1 / denom' ≤ 1 / denom, by
  { have : |(-1)^n / denom'| = 1 / denom', by
    { suffices : 1 / |denom'| = 1 / denom', by rwa [abs_div, (abs_neg_one_pow n)],
      have : 0 < denom', by
      { have : 0 ≤ pred_conts.b, by
        { have : (fib n : K) ≤ pred_conts.b, by
          { have : ¬g.terminated_at (n - 2), from
              mt (terminated_stable (n.sub_le 2)) not_terminated_at_n,
            exact (fib_le_of_continuants_aux_b $ or.inr this) },
          exact le_trans (by exact_mod_cast (fib n).zero_le) this },
        have : 0 < ifp_n.fr⁻¹, by
        { have zero_le_ifp_n_fract : 0 ≤ ifp_n.fr, from
            int_fract_pair.nth_stream_fr_nonneg stream_nth_eq,
          exact inv_pos.elim_right
            (lt_of_le_of_ne zero_le_ifp_n_fract stream_nth_fr_ne_zero.symm) },
        any_goals { repeat { apply mul_pos <|> apply add_pos_of_nonneg_of_pos } }; assumption },
      rwa (abs_of_pos this) },
    rwa this },
  suffices : 0 < denom ∧ denom ≤ denom', from
    div_le_div_of_le_left zero_le_one this.left this.right,
  split,
  { have : 0 < pred_conts.b + gp.b * conts.b, from
      lt_of_lt_of_le
      (by exact_mod_cast (fib_pos (lt_of_le_of_ne n.succ.succ.zero_le n.succ.succ_ne_zero.symm)))
      nextConts_b_ineq,
    solve_by_elim [mul_pos] },
  { -- we can cancel multiplication by `conts.b` and addition with `pred_conts.b`
    suffices : gp.b * conts.b ≤ ifp_n.fr⁻¹ * conts.b, from
      ((mul_le_mul_left zero_lt_conts_b).elim_right $
        (add_le_add_iff_left pred_conts.b).elim_right this),
    suffices : (ifp_succ_n.b : K) * conts.b ≤ ifp_n.fr⁻¹ * conts.b, by rwa [←ifp_succ_n_b_eq_gp_b],
    have : (ifp_succ_n.b : K) ≤ ifp_n.fr⁻¹, from
      int_fract_pair.succ_nth_stream_b_le_nth_stream_fr_inv stream_nth_eq succ_nth_stream_eq,
    have : 0 ≤ conts.b, from le_of_lt zero_lt_conts_b,
    mono }
end

/--
Shows that `|v - Aₙ / Bₙ| ≤ 1 / (bₙ * Bₙ * Bₙ)`. This bound is worse than the one shown in
`gcf.abs_sub_convergents_le`, but sometimes it is easier to apply and sufficient for one's use case.
 -/
lemma abs_sub_convergents_le' {b : K}
  (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) :
  |v - (of v).convergents n| ≤ 1 / (b * ((of v).denominators n) * ((of v).denominators n)) :=
begin
  have not_terminated_at_n : ¬(of v).terminated_at n,
    by simp [terminated_at_iff_part_denom_none, nth_part_denom_eq],
  refine (abs_sub_convergents_le not_terminated_at_n).trans _,
  -- One can show that `0 < (generalized_continued_fraction.of v).denominators n` but it's easier
  -- to consider the case `(generalized_continued_fraction.of v).denominators n = 0`.
  rcases zero_le_of_denom.eq_or_gt
    with (hB : (generalized_continued_fraction.of v).denominators n = 0) | hB,
  { simp only [hB, mul_zero, zero_mul, div_zero] },
  { apply one_div_le_one_div_of_le,
    { have : 0 < b := zero_lt_one.trans_le (of_one_le_nth_part_denom nth_part_denom_eq),
      apply_rules [mul_pos] },
    { conv_rhs { rw [mul_comm] },
      exact mul_le_mul_of_nonneg_right (le_of_succ_nth_denom nth_part_denom_eq) hB.le } }
end

end error_term

end generalized_continued_fraction


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import geometry.euclidean.basic

/-!
# Spheres

This file proves basic geometrical results about distances and angles
in spheres in real inner product spaces and Euclidean affine spaces.

## Main theorems

* `mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi`: Intersecting Chords Theorem (Freek No. 55).
* `mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_zero`: Intersecting Secants Theorem.
-/

open real
open_locale euclidean_geometry real_inner_product_space real

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

namespace inner_product_geometry

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

This section develops some results on spheres in real inner product spaces,
which are used to deduce corresponding results for Euclidean affine spaces.
-/

lemma mul_norm_eq_abs_sub_sq_norm {x y z : V}
  (h₁ : ∃ k : ℝ, k ≠ 1 ∧ x + y = k • (x - y)) (h₂ : ∥z - y∥ = ∥z + y∥) :
  ∥x - y∥ * ∥x + y∥ = abs (∥z + y∥ ^ 2 - ∥z - x∥ ^ 2) :=
begin
  obtain ⟨k, hk_ne_one, hk⟩ := h₁,
  let r := (k - 1)⁻¹ * (k + 1),

  have hxy : x = r • y,
  { rw [← smul_smul, eq_inv_smul_iff' (sub_ne_zero.mpr hk_ne_one), ← sub_eq_zero],
    calc  (k - 1) • x - (k + 1) • y
        = (k • x - x) - (k • y + y) : by simp_rw [sub_smul, add_smul, one_smul]
    ... = (k • x - k • y) - (x + y) : by simp_rw [← sub_sub, sub_right_comm]
    ... = k • (x - y) - (x + y)     : by rw ← smul_sub k x y
    ... = 0                         : sub_eq_zero.mpr hk.symm },

  have hzy : ⟪z, y⟫ = 0,
  { rw [← eq_of_sq_eq_sq (norm_nonneg (z - y)) (norm_nonneg (z + y)),
        norm_add_sq_real, norm_sub_sq_real] at h₂,
    linarith },

  have hzx : ⟪z, x⟫ = 0 := by rw [hxy, inner_smul_right, hzy, mul_zero],

  calc  ∥x - y∥ * ∥x + y∥
      = ∥(r - 1) • y∥ * ∥(r + 1) • y∥      : by simp [sub_smul, add_smul, hxy]
  ... = ∥r - 1∥ * ∥y∥ * (∥r + 1∥ * ∥y∥)      : by simp_rw [norm_smul]
  ... = ∥r - 1∥ * ∥r + 1∥ * ∥y∥ ^ 2         : by ring
  ... = abs ((r - 1) * (r + 1) * ∥y∥ ^ 2) : by simp [abs_mul, norm_eq_abs]
  ... = abs (r ^ 2 * ∥y∥ ^ 2 - ∥y∥ ^ 2)    : by ring_nf
  ... = abs (∥x∥ ^ 2 - ∥y∥ ^ 2)            : by simp [hxy, norm_smul, mul_pow, norm_eq_abs, sq_abs]
  ... = abs (∥z + y∥ ^ 2 - ∥z - x∥ ^ 2)    : by simp [norm_add_sq_real, norm_sub_sq_real,
                                                    hzy, hzx, abs_sub],
end

end inner_product_geometry

namespace euclidean_geometry

/-!
### Geometrical results on spheres in Euclidean affine spaces

This section develops some results on spheres in Euclidean affine spaces.
-/

open inner_product_geometry

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

/-- If `P` is a point on the line `AB` and `Q` is equidistant from `A` and `B`, then
`AP * BP = abs (BQ ^ 2 - PQ ^ 2)`. -/
lemma mul_dist_eq_abs_sub_sq_dist {a b p q : P}
  (hp : ∃ k : ℝ, k ≠ 1 ∧ b -ᵥ p = k • (a -ᵥ p)) (hq : dist a q = dist b q) :
  dist a p * dist b p = abs (dist b q ^ 2 - dist p q ^ 2) :=
begin
  let m : P := midpoint ℝ a b,
  obtain ⟨v, h1, h2, h3⟩ := ⟨vsub_sub_vsub_cancel_left, v a p m, v p q m, v a q m⟩,
  have h : ∀ r, b -ᵥ r = (m -ᵥ r) + (m -ᵥ a) :=
    λ r, by rw [midpoint_vsub_left, ← right_vsub_midpoint, add_comm, vsub_add_vsub_cancel],
  iterate 4 { rw dist_eq_norm_vsub V },
  rw [← h1, ← h2, h, h],
  rw [← h1, h] at hp,
  rw [dist_eq_norm_vsub V a q, dist_eq_norm_vsub V b q, ← h3, h] at hq,
  exact mul_norm_eq_abs_sub_sq_norm hp hq,
end

/-- If `A`, `B`, `C`, `D` are cospherical and `P` is on both lines `AB` and `CD`, then
`AP * BP = CP * DP`. -/
lemma mul_dist_eq_mul_dist_of_cospherical {a b c d p : P}
  (h : cospherical ({a, b, c, d} : set P))
  (hapb : ∃ k₁ : ℝ, k₁ ≠ 1 ∧ b -ᵥ p = k₁ • (a -ᵥ p))
  (hcpd : ∃ k₂ : ℝ, k₂ ≠ 1 ∧ d -ᵥ p = k₂ • (c -ᵥ p)) :
  dist a p * dist b p = dist c p * dist d p :=
begin
  obtain ⟨q, r, h'⟩ := (cospherical_def {a, b, c, d}).mp h,
  obtain ⟨ha, hb, hc, hd⟩ := ⟨h' a _, h' b _, h' c _, h' d _⟩,
  { rw ← hd at hc,
    rw ← hb at ha,
    rw [mul_dist_eq_abs_sub_sq_dist hapb ha, hb, mul_dist_eq_abs_sub_sq_dist hcpd hc, hd] },
  all_goals { simp },
end

/-- Intersecting Chords Theorem. -/
theorem mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi {a b c d p : P}
  (h : cospherical ({a, b, c, d} : set P))
  (hapb : ∠ a p b = π) (hcpd : ∠ c p d = π) :
  dist a p * dist b p = dist c p * dist d p :=
begin
  obtain ⟨-, k₁, _, hab⟩ := angle_eq_pi_iff.mp hapb,
  obtain ⟨-, k₂, _, hcd⟩ := angle_eq_pi_iff.mp hcpd,
  exact mul_dist_eq_mul_dist_of_cospherical h ⟨k₁, (by linarith), hab⟩ ⟨k₂, (by linarith), hcd⟩,
end

/-- Intersecting Secants Theorem. -/
theorem mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_zero {a b c d p : P}
  (h : cospherical ({a, b, c, d} : set P))
  (hab : a ≠ b) (hcd : c ≠ d) (hapb : ∠ a p b = 0) (hcpd : ∠ c p d = 0) :
  dist a p * dist b p = dist c p * dist d p :=
begin
  obtain ⟨-, k₁, -, hab₁⟩ := angle_eq_zero_iff.mp hapb,
  obtain ⟨-, k₂, -, hcd₁⟩ := angle_eq_zero_iff.mp hcpd,
  refine mul_dist_eq_mul_dist_of_cospherical h ⟨k₁, _, hab₁⟩ ⟨k₂, _, hcd₁⟩;
  by_contra hnot;
  simp only [not_not, *, one_smul] at *,
  exacts [hab (vsub_left_cancel hab₁).symm, hcd (vsub_left_cancel hcd₁).symm],
end

end euclidean_geometry


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import data.finsupp.indicator
import algebra.big_operators.pi
import algebra.big_operators.ring
import algebra.big_operators.order
import group_theory.submonoid.membership

/-!
# Big operators for finsupps

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

This file contains theorems relevant to big operators in finitely supported functions.
-/

noncomputable theory

open finset function
open_locale big_operators

variables {α ι γ A B C : Type*} [add_comm_monoid A] [add_comm_monoid B] [add_comm_monoid C]
variables {t : ι → A → C} (h0 : ∀ i, t i 0 = 0) (h1 : ∀ i x y, t i (x + y) = t i x + t i y)
variables {s : finset α} {f : α → (ι →₀ A)} (i : ι)
variables (g : ι →₀ A) (k : ι → A → γ → B) (x : γ)

variables {β M M' N P G H R S : Type*}

namespace finsupp

/-!
### Declarations about `sum` and `prod`

In most of this section, the domain `β` is assumed to be an `add_monoid`.
-/

section sum_prod

/-- `prod f g` is the product of `g a (f a)` over the support of `f`. -/
@[to_additive "`sum f g` is the sum of `g a (f a)` over the support of `f`. "]
def prod [has_zero M] [comm_monoid N] (f : α →₀ M) (g : α → M → N) : N :=
∏ a in f.support, g a (f a)

variables [has_zero M] [has_zero M'] [comm_monoid N]

@[to_additive]
lemma prod_of_support_subset (f : α →₀ M) {s : finset α}
  (hs : f.support ⊆ s) (g : α → M → N) (h : ∀ i ∈ s, g i 0 = 1) :
  f.prod g = ∏ x in s, g x (f x) :=
finset.prod_subset hs $ λ x hxs hx, h x hxs ▸ congr_arg (g x) $ not_mem_support_iff.1 hx

@[to_additive]
lemma prod_fintype [fintype α] (f : α →₀ M) (g : α → M → N) (h : ∀ i, g i 0 = 1) :
  f.prod g = ∏ i, g i (f i) :=
f.prod_of_support_subset (subset_univ _) g (λ x _, h x)

@[simp, to_additive]
lemma prod_single_index {a : α} {b : M} {h : α → M → N} (h_zero : h a 0 = 1) :
  (single a b).prod h = h a b :=
calc (single a b).prod h = ∏ x in {a}, h x (single a b x) :
  prod_of_support_subset _ support_single_subset h $
    λ x hx, (mem_singleton.1 hx).symm ▸ h_zero
... = h a b : by simp

@[to_additive]

@[simp, to_additive]
lemma prod_zero_index {h : α → M → N} : (0 : α →₀ M).prod h = 1 := rfl

@[to_additive]
lemma prod_comm (f : α →₀ M) (g : β →₀ M') (h : α → M → β → M' → N) :
  f.prod (λ x v, g.prod (λ x' v', h x v x' v')) = g.prod (λ x' v', f.prod (λ x v, h x v x' v')) :=
finset.prod_comm

@[simp, to_additive]
lemma prod_ite_eq [decidable_eq α] (f : α →₀ M) (a : α) (b : α → M → N) :
  f.prod (λ x v, ite (a = x) (b x v) 1) = ite (a ∈ f.support) (b a (f a)) 1 :=
by { dsimp [finsupp.prod], rw f.support.prod_ite_eq, }

@[simp] lemma sum_ite_self_eq
  [decidable_eq α] {N : Type*} [add_comm_monoid N] (f : α →₀ N) (a : α) :
  f.sum (λ x v, ite (a = x) v 0) = f a :=
begin
  classical,
  convert f.sum_ite_eq a (λ x, id),
  simp [ite_eq_right_iff.2 eq.symm]
end

/-- A restatement of `prod_ite_eq` with the equality test reversed. -/
@[simp, to_additive "A restatement of `sum_ite_eq` with the equality test reversed."]
lemma prod_ite_eq' [decidable_eq α] (f : α →₀ M) (a : α) (b : α → M → N) :
  f.prod (λ x v, ite (x = a) (b x v) 1) = ite (a ∈ f.support) (b a (f a)) 1 :=
by { dsimp [finsupp.prod], rw f.support.prod_ite_eq', }

@[simp] lemma sum_ite_self_eq'
  [decidable_eq α] {N : Type*} [add_comm_monoid N] (f : α →₀ N) (a : α) :
  f.sum (λ x v, ite (x = a) v 0) = f a :=
begin
  classical,
  convert f.sum_ite_eq' a (λ x, id),
  simp [ite_eq_right_iff.2 eq.symm]
end

@[simp] lemma prod_pow [fintype α] (f : α →₀ ℕ) (g : α → N) :
  f.prod (λ a b, g a ^ b) = ∏ a, g a ^ (f a) :=
f.prod_fintype _ $ λ a, pow_zero _

/-- If `g` maps a second argument of 0 to 1, then multiplying it over the
result of `on_finset` is the same as multiplying it over the original
`finset`. -/
@[to_additive "If `g` maps a second argument of 0 to 0, summing it over the
result of `on_finset` is the same as summing it over the original
`finset`."]
lemma on_finset_prod {s : finset α} {f : α → M} {g : α → M → N}
    (hf : ∀a, f a ≠ 0 → a ∈ s) (hg : ∀ a, g a 0 = 1) :
  (on_finset s f hf).prod g = ∏ a in s, g a (f a) :=
finset.prod_subset support_on_finset_subset $ by simp [*] { contextual := tt }

/-- Taking a product over `f : α →₀ M` is the same as multiplying the value on a single element
`y ∈ f.support` by the product over `erase y f`. -/
@[to_additive /-" Taking a sum over over `f : α →₀ M` is the same as adding the value on a
single element `y ∈ f.support` to the sum over `erase y f`. "-/]
lemma mul_prod_erase (f : α →₀ M) (y : α) (g : α → M → N) (hyf : y ∈ f.support) :
  g y (f y) * (erase y f).prod g = f.prod g :=
begin
  classical,
  rw [finsupp.prod, finsupp.prod, ←finset.mul_prod_erase _ _ hyf, finsupp.support_erase,
    finset.prod_congr rfl],
  intros h hx,
  rw finsupp.erase_ne (ne_of_mem_erase hx),
end

/-- Generalization of `finsupp.mul_prod_erase`: if `g` maps a second argument of 0 to 1,
then its product over `f : α →₀ M` is the same as multiplying the value on any element
`y : α` by the product over `erase y f`. -/
@[to_additive /-" Generalization of `finsupp.add_sum_erase`: if `g` maps a second argument of 0
to 0, then its sum over `f : α →₀ M` is the same as adding the value on any element
`y : α` to the sum over `erase y f`. "-/]
lemma mul_prod_erase' (f : α →₀ M) (y : α) (g : α → M → N) (hg : ∀ (i : α), g i 0 = 1) :
  g y (f y) * (erase y f).prod g = f.prod g :=
begin
  classical,
  by_cases hyf : y ∈ f.support,
  { exact finsupp.mul_prod_erase f y g hyf },
  { rw [not_mem_support_iff.mp hyf, hg y, erase_of_not_mem_support hyf, one_mul] },
end

@[to_additive]
lemma _root_.submonoid_class.finsupp_prod_mem {S : Type*} [set_like S N] [submonoid_class S N]
  (s : S) (f : α →₀ M) (g : α → M → N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ s) : f.prod g ∈ s :=
prod_mem $ λ i hi, h _ (finsupp.mem_support_iff.mp hi)

@[to_additive]
lemma prod_congr {f : α →₀ M} {g1 g2 : α → M → N}
  (h : ∀ x ∈ f.support, g1 x (f x) = g2 x (f x)) : f.prod g1 = f.prod g2 :=
finset.prod_congr rfl h

end sum_prod

end finsupp

@[to_additive]
lemma map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] {H : Type*}
  [monoid_hom_class H N P] (h : H) (f : α →₀ M) (g : α → M → N) :
  h (f.prod g) = f.prod (λ a b, h (g a b)) :=
map_prod h _ _

/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/
@[to_additive "Deprecated, use `_root_.map_finsupp_sum` instead."]
protected lemma mul_equiv.map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P]
  (h : N ≃* P) (f : α →₀ M) (g : α → M → N) : h (f.prod g) = f.prod (λ a b, h (g a b)) :=
map_finsupp_prod h f g

/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/
@[to_additive "Deprecated, use `_root_.map_finsupp_sum` instead."]
protected lemma monoid_hom.map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P]
  (h : N →* P) (f : α →₀ M) (g : α → M → N) : h (f.prod g) = f.prod (λ a b, h (g a b)) :=
map_finsupp_prod h f g

/-- Deprecated, use `_root_.map_finsupp_sum` instead. -/
protected lemma ring_hom.map_finsupp_sum [has_zero M] [semiring R] [semiring S]
  (h : R →+* S) (f : α →₀ M) (g : α → M → R) : h (f.sum g) = f.sum (λ a b, h (g a b)) :=
map_finsupp_sum h f g

/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/
protected lemma ring_hom.map_finsupp_prod [has_zero M] [comm_semiring R] [comm_semiring S]
  (h : R →+* S) (f : α →₀ M) (g : α → M → R) : h (f.prod g) = f.prod (λ a b, h (g a b)) :=
map_finsupp_prod h f g

@[to_additive]
lemma monoid_hom.coe_finsupp_prod [has_zero β] [monoid N] [comm_monoid P]
  (f : α →₀ β) (g : α → β → N →* P) :
  ⇑(f.prod g) = f.prod (λ i fi, g i fi) :=
monoid_hom.coe_finset_prod _ _

@[simp, to_additive]
lemma monoid_hom.finsupp_prod_apply [has_zero β] [monoid N] [comm_monoid P]
  (f : α →₀ β) (g : α → β → N →* P) (x : N) :
  f.prod g x = f.prod (λ i fi, g i fi x) :=
monoid_hom.finset_prod_apply _ _ _

namespace finsupp

lemma single_multiset_sum [add_comm_monoid M] (s : multiset M) (a : α) :
  single a s.sum = (s.map (single a)).sum :=
multiset.induction_on s (single_zero _) $ λ a s ih,
by rw [multiset.sum_cons, single_add, ih, multiset.map_cons, multiset.sum_cons]

lemma single_finset_sum [add_comm_monoid M] (s : finset ι) (f : ι → M) (a : α) :
  single a (∑ b in s, f b) = ∑ b in s, single a (f b) :=
begin
  transitivity,
  apply single_multiset_sum,
  rw [multiset.map_map],
  refl
end

lemma single_sum [has_zero M] [add_comm_monoid N] (s : ι →₀ M) (f : ι → M → N) (a : α) :
  single a (s.sum f) = s.sum (λd c, single a (f d c)) :=
single_finset_sum _ _ _

@[to_additive]
lemma prod_neg_index [add_group G] [comm_monoid M] {g : α →₀ G} {h : α → G → M}
  (h0 : ∀a, h a 0 = 1) :
  (-g).prod h = g.prod (λa b, h a (- b)) :=
prod_map_range_index h0

end finsupp

namespace finsupp

lemma finset_sum_apply [add_comm_monoid N] (S : finset ι) (f : ι → α →₀ N) (a : α) :
  (∑ i in S, f i) a = ∑ i in S, f i a :=
(apply_add_hom a : (α →₀ N) →+ _).map_sum _ _

@[simp] lemma sum_apply [has_zero M] [add_comm_monoid N]
  {f : α →₀ M} {g : α → M → β →₀ N} {a₂ : β} :
  (f.sum g) a₂ = f.sum (λa₁ b, g a₁ b a₂) :=
finset_sum_apply _ _ _

lemma coe_finset_sum [add_comm_monoid N] (S : finset ι) (f : ι → α →₀ N) :
  ⇑(∑ i in S, f i) = ∑ i in S, f i :=
(coe_fn_add_hom : (α →₀ N) →+ _).map_sum _ _

lemma coe_sum [has_zero M] [add_comm_monoid N] (f : α →₀ M) (g : α → M → β →₀ N) :
  ⇑(f.sum g) = f.sum (λ a₁ b, g a₁ b) :=
coe_finset_sum _ _

lemma support_sum [decidable_eq β] [has_zero M] [add_comm_monoid N]
  {f : α →₀ M} {g : α → M → (β →₀ N)} :
  (f.sum g).support ⊆ f.support.bUnion (λa, (g a (f a)).support) :=
have ∀ c, f.sum (λ a b, g a b c) ≠ 0 → (∃ a, f a ≠ 0 ∧ ¬ (g a (f a)) c = 0),
  from assume a₁ h,
  let ⟨a, ha, ne⟩ := finset.exists_ne_zero_of_sum_ne_zero h in
  ⟨a, mem_support_iff.mp ha, ne⟩,
by simpa only [finset.subset_iff, mem_support_iff, finset.mem_bUnion, sum_apply, exists_prop]

lemma support_finset_sum [decidable_eq β] [add_comm_monoid M] {s : finset α} {f : α → (β →₀ M)} :
  (finset.sum s f).support ⊆ s.bUnion (λ x, (f x).support) :=
begin
  rw ←finset.sup_eq_bUnion,
  induction s using finset.cons_induction_on with a s ha ih,
  { refl },
  { rw [finset.sum_cons, finset.sup_cons],
    exact support_add.trans (finset.union_subset_union (finset.subset.refl _) ih), },
end

@[simp] lemma sum_zero [has_zero M] [add_comm_monoid N] {f : α →₀ M} :
  f.sum (λa b, (0 : N)) = 0 :=
finset.sum_const_zero

@[simp, to_additive]
lemma prod_mul  [has_zero M] [comm_monoid N] {f : α →₀ M} {h₁ h₂ : α → M → N} :
  f.prod (λa b, h₁ a b * h₂ a b) = f.prod h₁ * f.prod h₂ :=
finset.prod_mul_distrib

@[simp, to_additive]
lemma prod_inv [has_zero M] [comm_group G] {f : α →₀ M}
  {h : α → M → G} : f.prod (λa b, (h a b)⁻¹) = (f.prod h)⁻¹ :=
(map_prod ((monoid_hom.id G)⁻¹) _ _).symm

@[simp] lemma sum_sub [has_zero M] [add_comm_group G] {f : α →₀ M}
  {h₁ h₂ : α → M → G} :
  f.sum (λa b, h₁ a b - h₂ a b) = f.sum h₁ - f.sum h₂ :=
finset.sum_sub_distrib

/-- Taking the product under `h` is an additive-to-multiplicative homomorphism of finsupps,
if `h` is an additive-to-multiplicative homomorphism on the support.
This is a more general version of `finsupp.prod_add_index'`; the latter has simpler hypotheses. -/
@[to_additive "Taking the product under `h` is an additive homomorphism of finsupps,
if `h` is an additive homomorphism on the support.
This is a more general version of `finsupp.sum_add_index'`; the latter has simpler hypotheses."]
lemma prod_add_index [decidable_eq α] [add_zero_class M] [comm_monoid N] {f g : α →₀ M}
  {h : α → M → N} (h_zero : ∀ a ∈ f.support ∪ g.support, h a 0 = 1)
  (h_add : ∀ (a ∈ f.support ∪ g.support) b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) :
  (f + g).prod h = f.prod h * g.prod h :=
begin
  rw [finsupp.prod_of_support_subset f (subset_union_left _ g.support) h h_zero,
      finsupp.prod_of_support_subset g (subset_union_right f.support _) h h_zero,
      ←finset.prod_mul_distrib,
      finsupp.prod_of_support_subset (f + g) finsupp.support_add h h_zero],
  exact finset.prod_congr rfl (λ x hx, (by apply h_add x hx)),
end

/-- Taking the product under `h` is an additive-to-multiplicative homomorphism of finsupps,
if `h` is an additive-to-multiplicative homomorphism.
This is a more specialized version of `finsupp.prod_add_index` with simpler hypotheses. -/
@[to_additive "Taking the sum under `h` is an additive homomorphism of finsupps,
if `h` is an additive homomorphism.
This is a more specific version of `finsupp.sum_add_index` with simpler hypotheses."]
lemma prod_add_index' [add_zero_class M] [comm_monoid N] {f g : α →₀ M}
  {h : α → M → N} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) :
  (f + g).prod h = f.prod h * g.prod h :=
by classical; exact prod_add_index (λ a ha, h_zero a) (λ a ha, h_add a)

@[simp]
lemma sum_hom_add_index [add_zero_class M] [add_comm_monoid N] {f g : α →₀ M} (h : α → M →+ N) :
  (f + g).sum (λ x, h x) = f.sum (λ x, h x) + g.sum (λ x, h x) :=
sum_add_index' (λ a, (h a).map_zero) (λ a, (h a).map_add)

@[simp]
lemma prod_hom_add_index [add_zero_class M] [comm_monoid N] {f g : α →₀ M}
  (h : α → multiplicative M →* N) :
  (f + g).prod (λ a b, h a (multiplicative.of_add b)) =
    f.prod (λ a b, h a (multiplicative.of_add b)) * g.prod (λ a b, h a (multiplicative.of_add b)) :=
prod_add_index' (λ a, (h a).map_one) (λ a, (h a).map_mul)

/-- The canonical isomorphism between families of additive monoid homomorphisms `α → (M →+ N)`
and monoid homomorphisms `(α →₀ M) →+ N`. -/
def lift_add_hom [add_zero_class M] [add_comm_monoid N] : (α → M →+ N) ≃+ ((α →₀ M) →+ N) :=
{ to_fun := λ F,
  { to_fun := λ f, f.sum (λ x, F x),
    map_zero' := finset.sum_empty,
    map_add' := λ _ _, sum_add_index' (λ x, (F x).map_zero) (λ x, (F x).map_add) },
  inv_fun := λ F x, F.comp $ single_add_hom x,
  left_inv := λ F, by { ext, simp },
  right_inv := λ F, by { ext, simp },
  map_add' := λ F G, by { ext, simp } }

@[simp] lemma lift_add_hom_apply [add_comm_monoid M] [add_comm_monoid N]
  (F : α → M →+ N) (f : α →₀ M) :
  lift_add_hom F f = f.sum (λ x, F x) :=
rfl

@[simp] lemma lift_add_hom_symm_apply [add_comm_monoid M] [add_comm_monoid N]
  (F : (α →₀ M) →+ N) (x : α) :
  lift_add_hom.symm F x = F.comp (single_add_hom x) :=
rfl

lemma lift_add_hom_symm_apply_apply [add_comm_monoid M] [add_comm_monoid N]
  (F : (α →₀ M) →+ N) (x : α) (y : M) :
  lift_add_hom.symm F x y = F (single x y) :=
rfl

@[simp] lemma lift_add_hom_single_add_hom [add_comm_monoid M] :
  lift_add_hom (single_add_hom : α → M →+ α →₀ M) = add_monoid_hom.id _ :=
lift_add_hom.to_equiv.apply_eq_iff_eq_symm_apply.2 rfl

@[simp] lemma sum_single [add_comm_monoid M] (f : α →₀ M) :
  f.sum single = f :=
add_monoid_hom.congr_fun lift_add_hom_single_add_hom f

@[simp] lemma sum_univ_single [add_comm_monoid M] [fintype α] (i : α) (m : M) :
  ∑ (j : α), (single i m) j = m :=
by simp [single]

@[simp] lemma sum_univ_single' [add_comm_monoid M] [fintype α] (i : α) (m : M) :
  ∑ (j : α), (single j m) i = m :=
by simp [single]

@[simp] lemma lift_add_hom_apply_single [add_comm_monoid M] [add_comm_monoid N]
  (f : α → M →+ N) (a : α) (b : M) :
  lift_add_hom f (single a b) = f a b :=
sum_single_index (f a).map_zero

@[simp] lemma lift_add_hom_comp_single [add_comm_monoid M] [add_comm_monoid N] (f : α → M →+ N)
  (a : α) :
  (lift_add_hom f).comp (single_add_hom a) = f a :=
add_monoid_hom.ext $ λ b, lift_add_hom_apply_single f a b

lemma comp_lift_add_hom [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
  (g : N →+ P) (f : α → M →+ N) :
  g.comp (lift_add_hom f) = lift_add_hom (λ a, g.comp (f a)) :=
lift_add_hom.symm_apply_eq.1 $ funext $ λ a,
  by rw [lift_add_hom_symm_apply, add_monoid_hom.comp_assoc, lift_add_hom_comp_single]

lemma sum_sub_index [add_comm_group β] [add_comm_group γ] {f g : α →₀ β}
  {h : α → β → γ} (h_sub : ∀a b₁ b₂, h a (b₁ - b₂) = h a b₁ - h a b₂) :
  (f - g).sum h = f.sum h - g.sum h :=
(lift_add_hom (λ a, add_monoid_hom.of_map_sub (h a) (h_sub a))).map_sub f g

@[to_additive]
lemma prod_emb_domain [has_zero M] [comm_monoid N] {v : α →₀ M} {f : α ↪ β} {g : β → M → N} :
  (v.emb_domain f).prod g = v.prod (λ a b, g (f a) b) :=
begin
  rw [prod, prod, support_emb_domain, finset.prod_map],
  simp_rw emb_domain_apply,
end

@[to_additive]
lemma prod_finset_sum_index [add_comm_monoid M] [comm_monoid N]
  {s : finset ι} {g : ι → α →₀ M}
  {h : α → M → N} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) :
  ∏ i in s, (g i).prod h = (∑ i in s, g i).prod h :=
finset.cons_induction_on s rfl $ λ a s has ih,
by rw [prod_cons, ih, sum_cons, prod_add_index' h_zero h_add]

@[to_additive]
lemma prod_sum_index
  [add_comm_monoid M] [add_comm_monoid N] [comm_monoid P]
  {f : α →₀ M} {g : α → M → β →₀ N}
  {h : β → N → P} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) :
  (f.sum g).prod h = f.prod (λa b, (g a b).prod h) :=
(prod_finset_sum_index h_zero h_add).symm

lemma multiset_sum_sum_index
  [add_comm_monoid M] [add_comm_monoid N]
  (f : multiset (α →₀ M)) (h : α → M → N)
  (h₀ : ∀a, h a 0 = 0) (h₁ : ∀ (a : α) (b₁ b₂ : M), h a (b₁ + b₂) = h a b₁ + h a b₂) :
  (f.sum.sum h) = (f.map $ λg:α →₀ M, g.sum h).sum :=
multiset.induction_on f rfl $ assume a s ih,
by rw [multiset.sum_cons, multiset.map_cons, multiset.sum_cons, sum_add_index' h₀ h₁, ih]

lemma support_sum_eq_bUnion {α : Type*} {ι : Type*} {M : Type*} [decidable_eq α]
  [add_comm_monoid M]
  {g : ι → α →₀ M} (s : finset ι) (h : ∀ i₁ i₂, i₁ ≠ i₂ → disjoint (g i₁).support (g i₂).support) :
  (∑ i in s, g i).support = s.bUnion (λ i, (g i).support) :=
begin
  classical,
  apply finset.induction_on s,
  { simp },
  { intros i s hi,
    simp only [hi, sum_insert, not_false_iff, bUnion_insert],
    intro hs,
    rw [finsupp.support_add_eq, hs],
    rw [hs, finset.disjoint_bUnion_right],
    intros j hj,
    refine h _ _ (ne_of_mem_of_not_mem hj hi).symm }
end

lemma multiset_map_sum [has_zero M] {f : α →₀ M} {m : β → γ} {h : α → M → multiset β} :
  multiset.map m (f.sum h) = f.sum (λa b, (h a b).map m) :=
(multiset.map_add_monoid_hom m).map_sum _ f.support

lemma multiset_sum_sum [has_zero M] [add_comm_monoid N] {f : α →₀ M} {h : α → M → multiset N} :
  multiset.sum (f.sum h) = f.sum (λa b, multiset.sum (h a b)) :=
(multiset.sum_add_monoid_hom : multiset N →+ N).map_sum _ f.support

/-- For disjoint `f1` and `f2`, and function `g`, the product of the products of `g`
over `f1` and `f2` equals the product of `g` over `f1 + f2` -/
@[to_additive "For disjoint `f1` and `f2`, and function `g`, the sum of the sums of `g`
over `f1` and `f2` equals the sum of `g` over `f1 + f2`"]
lemma prod_add_index_of_disjoint [add_comm_monoid M] {f1 f2 : α →₀ M}
  (hd : disjoint f1.support f2.support) {β : Type*} [comm_monoid β] (g : α → M → β) :
  (f1 + f2).prod g = f1.prod g * f2.prod g :=
have ∀ {f1 f2 : α →₀ M}, disjoint f1.support f2.support →
  ∏ x in f1.support, g x (f1 x + f2 x) = f1.prod g :=
  λ f1 f2 hd, finset.prod_congr rfl (λ x hx,
    by simp only [not_mem_support_iff.mp (disjoint_left.mp hd hx), add_zero]),
begin
  classical,
  simp_rw [← this hd, ← this hd.symm,
    add_comm (f2 _), finsupp.prod, support_add_eq hd, prod_union hd, add_apply]
end

lemma prod_dvd_prod_of_subset_of_dvd [add_comm_monoid M] [comm_monoid N]
  {f1 f2 : α →₀ M} {g1 g2 : α → M → N} (h1 : f1.support ⊆ f2.support)
  (h2 : ∀ (a : α), a ∈ f1.support → g1 a (f1 a) ∣ g2 a (f2 a)) :
  f1.prod g1 ∣ f2.prod g2 :=
begin
  classical,
  simp only [finsupp.prod, finsupp.prod_mul],
  rw [←sdiff_union_of_subset h1, prod_union sdiff_disjoint],
  apply dvd_mul_of_dvd_right,
  apply prod_dvd_prod_of_dvd,
  exact h2,
end

lemma indicator_eq_sum_single [add_comm_monoid M] (s : finset α) (f : Π a ∈ s, M) :
  indicator s f = ∑ x in s.attach, single x (f x x.2) :=
begin
  rw [← sum_single (indicator s f), sum, sum_subset (support_indicator_subset _ _), ← sum_attach],
  { refine finset.sum_congr rfl (λ x hx, _),
    rw [indicator_of_mem], },
  intros i _ hi,
  rw [not_mem_support_iff.mp hi, single_zero],
end

@[simp, to_additive]
lemma prod_indicator_index [has_zero M] [comm_monoid N]
  {s : finset α} (f : Π a ∈ s, M) {h : α → M → N} (h_zero : ∀ a ∈ s, h a 0 = 1) :
  (indicator s f).prod h = ∏ x in s.attach, h x (f x x.2) :=
begin
  rw [prod_of_support_subset _ (support_indicator_subset _ _) h h_zero, ← prod_attach],
  refine finset.prod_congr rfl (λ x hx, _),
  rw [indicator_of_mem],
end

end finsupp

theorem finset.sum_apply' : (∑ k in s, f k) i = ∑ k in s, f k i :=
(finsupp.apply_add_hom i : (ι →₀ A) →+ A).map_sum f s

theorem finsupp.sum_apply' : g.sum k x = g.sum (λ i b, k i b x) :=
finset.sum_apply _ _ _

section
include h0 h1

open_locale classical

theorem finsupp.sum_sum_index' : (∑ x in s, f x).sum t = ∑ x in s, (f x).sum t :=
finset.induction_on s rfl $ λ a s has ih,
by simp_rw [finset.sum_insert has, finsupp.sum_add_index' h0 h1, ih]

end

section
variables [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]

lemma finsupp.sum_mul (b : S) (s : α →₀ R) {f : α → R → S} :
  (s.sum f) * b = s.sum (λ a c, (f a c) * b) :=
by simp only [finsupp.sum, finset.sum_mul]

lemma finsupp.mul_sum (b : S) (s : α →₀ R) {f : α → R → S} :
  b * (s.sum f) = s.sum (λ a c, b * (f a c)) :=
by simp only [finsupp.sum, finset.mul_sum]

end

namespace nat

/-- If `0 : ℕ` is not in the support of `f : ℕ →₀ ℕ` then `0 < ∏ x in f.support, x ^ (f x)`. -/
lemma prod_pow_pos_of_zero_not_mem_support {f : ℕ →₀ ℕ} (hf : 0 ∉ f.support) : 0 < f.prod pow :=
finset.prod_pos (λ a ha, pos_iff_ne_zero.mpr (pow_ne_zero _ (λ H, by {subst H, exact hf ha})))

end nat


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

import ..free_groups
import ..subgroup
open function
open bounded_continuous_function

/-!
# DEMO : Implementation of Amenable Groups in Lean

In this file, we demonstrate the implementation of amenable groups in Lean.
This is intended to be done during a talk

## Main Steps

* Definition of Amenability
* Definition of (left invariant) means
* Theorem: If a group contains a free group (more precisely:
    of rank at least 2), then it is not amenable

## Note

We sometimes use the namespace 'hidden' in this file to avoid name clashes with existing declarations
(mainly for amenable, etc.).
-/

namespace hidden

variables (G:Type*) [group G]

structure mean
:= mk ::
  (lin_map : (bounded_continuous_function G ℝ) →ₗ[ℝ] ℝ)
  (normality : lin_map (const G 1) = 1)
  (positivity: ∀ {f : bounded_continuous_function G ℝ},
                          (∀ (x:G), f x ≥ 0) → lin_map f ≥ 0)

structure left_invariant_mean
  extends mean G
:= mk ::
  (left_invariance: ∀ g:G , ∀ f, lin_map (g•f) = lin_map f)

def amenable
  : Prop
:= nonempty (left_invariant_mean G)

end hidden

section
/-!
### Example

If a group G contains a free group
  (more precisely: If there is an injective group homomorphisms from a free group (of rank at least 2) into
  the group), then it is not amenable

-/

theorem contains_free_implies_not_amenable
  {G : Type*} [group G]
  {X : Type*}
  {x y : X}
  (x_neq_y : x ≠ y) -- needs to be added later
  {i           : free_group X →* G}
  (i_injective : injective i)
  : ¬ amenable G
:= begin
  assume G_amenable : amenable G,
  have range_amenable : amenable i.range
      := amenable_of_subgroup i.range G_amenable,
  have iso_freeX : i.range ≃* free_group X
      := iso_range_of_injective' i_injective,
  have freeX_amenable : amenable (free_group X)
      := amenable_of_iso iso_freeX range_amenable,

  have freeX_not_amenable : ¬ amenable (free_group X)
      := not_amenable_of_free x_neq_y,
  contradiction,
end

#check @not_amenable_of_free

end


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import data.fintype.basic
import data.list.perm

/-!

# Fintype instance for nodup lists

The subtype of `{l : list α // l.nodup}` over a `[fintype α]`
admits a `fintype` instance.

## Implementation details
To construct the `fintype` instance, a function lifting a `multiset α`
to the `finset (list α)` that can construct it is provided.
This function is applied to the `finset.powerset` of `finset.univ`.

In general, a `decidable_eq` instance is not necessary to define this function,
but a proof of `(list.permutations l).nodup` is required to avoid it,
which is a TODO.

-/

variables {α : Type*} [decidable_eq α]

open list

namespace multiset

/--
The `finset` of `l : list α` that, given `m : multiset α`, have the property `⟦l⟧ = m`.
-/
def lists : multiset α → finset (list α) :=
λ s, quotient.lift_on s (λ l, l.permutations.to_finset)
(λ l l' (h : l ~ l'),
  begin
    ext sl,
    simp only [mem_permutations, list.mem_to_finset],
    exact ⟨λ hs, hs.trans h, λ hs, hs.trans h.symm⟩
  end)

@[simp] lemma lists_coe (l : list α) :
  lists (l : multiset α) = l.permutations.to_finset := rfl

@[simp] lemma mem_lists_iff (s : multiset α) (l : list α) :
  l ∈ lists s ↔ s = ⟦l⟧ :=
begin
  induction s using quotient.induction_on,
  simpa using perm_comm
end

end multiset

instance fintype_nodup_list [fintype α] : fintype {l : list α // l.nodup} :=
fintype.subtype ((finset.univ : finset α).powerset.bUnion (λ s, s.val.lists)) (λ l,
  begin
    suffices : (∃ (a : finset α), a.val = ↑l) ↔ l.nodup,
    { simpa },
    split,
    { rintro ⟨s, hs⟩,
      simpa [←multiset.coe_nodup, ←hs] using s.nodup },
    { intro hl,
      refine ⟨⟨↑l, hl⟩, _⟩,
      simp }
  end)


-- Opuesto_se_cancela_con_la_suma_por_la_derecha.lean
-- Opuesto se cancela con la suma por la derecha
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 30-agosto-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si R es un anillo, entonces
--    ∀ a b : R, (a + b) + -b = a
-- ---------------------------------------------------------------------

import algebra.ring

variables {R : Type*} [ring R]
variables a b : R

-- 1ª demostración
-- ===============

example : (a + b) + -b = a :=
calc (a + b) + -b
     = a + (b + -b) : by rw add_assoc
 ... = a + 0        : by rw add_right_neg
 ... = a            : by rw add_zero

-- 2ª demostración
-- ===============

example : (a + b) + -b = a :=
begin
  rw add_assoc,
  rw add_right_neg,
  rw add_zero,
end

-- 3ª demostración
-- ===============

example : (a + b) + -b = a :=
by rw [add_assoc, add_right_neg, add_zero]

-- 4ª demostración
-- ===============

example : (a + b) + -b = a :=
-- by library_search
add_neg_eq_of_eq_add rfl

-- 5ª demostración
-- ===============

example : (a + b) + -b = a :=
-- by hint
by finish


example (A B C : Prop) : (A → B) → (B → C) → (A → C) := by
  intro (h₁: A → B)
  intro (h₂: B → C)
  intro (a : A)
  have (b : B) := by exact h₁ a
  exact h₂ b

#check @And.intro

example (A B : Prop) (a : A) (b : B) : A ∧ B := by
  apply And.intro
  exact a
  exact b


import data.fin.basic

namespace fin

lemma lt_or_eq_nat {n : ℕ} (i : fin n.succ) : (i : ℕ) < n ∨ (i : ℕ) = n :=
begin
  cases nat.decidable_lt i n with h,
  {
    right,
    exact nat.eq_of_lt_succ_of_not_lt (fin.is_lt i) h,
  },
  {
    left,
    exact h,
  }
end

lemma lt_coe_iff_val_lt {n m : ℕ} (i : fin n.succ) (hle : m < n.succ) :
  (i : ℕ) < m ↔ i < (m : fin n.succ) :=
begin
  rw fin.lt_def,
  repeat {rw fin.val_eq_coe},
  rw fin.coe_coe_of_lt hle,
end

lemma lt_or_eq_fin {n : ℕ} (i : fin n.succ) : i < (n : fin n.succ) ∨ i = (n : fin n.succ) :=
begin
  cases fin.lt_or_eq_nat i with h,
  {
    left,
    rw ← fin.lt_coe_iff_val_lt i (nat.lt_succ_self _),
    exact h,
  },
  {
    right,
    rw ← fin.coe_coe_eq_self i,
    have f := @congr_arg _ _ (i : ℕ) n fin.of_nat h,
    simp only [fin.of_nat_eq_coe] at f,
    exact f,
  }
end

/-- converts an n-ary tuple to an n.succ-ary tuple -/
@[simp] def x_val {A : Type*} {n} (x : A) (val : fin n → A) :
  fin n.succ → A :=
@fin.cases n (λ _, A) x (λ i, val i)

end fin


import algebra.module.basic linear_algebra.basis tactic

section one

variables (R : Type) (S : Type) [semiring R] [semiring S] (f : S →+* R)
variables (M : Type) [add_comm_monoid M] [module R M]

#check (•)
#check (•) ∘ f

/-

/-- Compose a `module` with a `ring_hom`, with action `f s • m` -/
def comp_hom [semiring S] (f : S →+* R) :
  module S M :=
  { smul := _,
  one_smul := _,
  mul_smul := _,
  smul_add := _,
  smul_zero := _,
  add_smul := _,
  zero_smul := _ }

-/

end one

section two

variables {ι : Type*} {ι' : Type*} {R : Type*} {K : Type*}
variables {M : Type*} {M' M'' : Type*} {V : Type u} {V' : Type*}

open module

variables [semiring R]
variables [add_comm_monoid M] [module R M] [add_comm_monoid M'] [module R M']

variables (b b₁ : basis ι R M) (i : ι) (c : R) (x : M)

/-
  (by simp only [b.coord_apply, finsupp.ext_iff, finsupp.zero_apply])
  b.repr.map_eq_zero_iff
-/
#check basis.coord_apply
#check finsupp.ext_iff
#check finsupp.zero_apply

lemma forall_coord_eq_zero_iff {x : M} {i : ι} :
  (∀ i, b.coord i x = 0) ↔ x = 0 :=
iff.trans
  (by simp only [b.coord_apply, finsupp.ext_iff, finsupp.zero_apply])
  b.repr.map_eq_zero_iff

/-TODO

begin
  split,
  { intros hi,
    specialize hi i,
    rw b.coord_apply at hi,
    rw ← finsupp.ext_iff at hi,
    sorry
  },
  { sorry},
end

-/

end two


/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.free_abelian_group
import Mathlib.ring_theory.subring
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Free rings

The theory of the free ring over a type.

## Main definitions

* `free_ring α` : the free (not commutative in general) ring over a type.
* `lift (f : α → R)` : the ring hom `free_ring α →+* R` induced by `f`.
* `map (f : α → β)` : the ring hom `free_ring α →+* free_ring β` induced by `f`.

## Implementation details

`free_ring α` is implemented as the free abelian group over the free monoid on `α`.

## Tags

free ring

-/

/-- The free ring over a type `α`. -/
def free_ring (α : Type u) := free_abelian_group (free_monoid α)

namespace free_ring

protected instance ring (α : Type u) : ring (free_ring α) := free_abelian_group.ring (free_monoid α)

protected instance inhabited (α : Type u) : Inhabited (free_ring α) := { default := 0 }

/-- The canonical map from α to `free_ring α`. -/
def of {α : Type u} (x : α) : free_ring α := free_abelian_group.of [x]

theorem of_injective {α : Type u} : function.injective of :=
  function.injective.comp free_abelian_group.of_injective free_monoid.of_injective

protected theorem induction_on {α : Type u} {C : free_ring α → Prop} (z : free_ring α)
    (hn1 : C (-1)) (hb : ∀ (b : α), C (of b)) (ha : ∀ (x y : free_ring α), C x → C y → C (x + y))
    (hm : ∀ (x y : free_ring α), C x → C y → C (x * y)) : C z :=
  sorry

/-- The ring homomorphism `free_ring α →+* R` induced from a map `α → R`. -/
def lift {α : Type u} {R : Type v} [ring R] (f : α → R) : free_ring α →+* R :=
  ring_hom.mk
    (add_monoid_hom.to_fun (free_abelian_group.lift fun (L : List α) => list.prod (list.map f L)))
    sorry sorry sorry sorry

@[simp] theorem lift_of {α : Type u} {R : Type v} [ring R] (f : α → R) (x : α) :
    coe_fn (lift f) (of x) = f x :=
  Eq.trans (free_abelian_group.lift.of (fun (L : List α) => list.prod (list.map f L)) [x])
    (one_mul (f x))

@[simp] theorem lift_comp_of {α : Type u} {R : Type v} [ring R] (f : free_ring α →+* R) :
    lift (⇑f ∘ of) = f :=
  sorry

/-- The canonical ring homomorphism `free_ring α →+* free_ring β` generated by a map `α → β`. -/
def map {α : Type u} {β : Type v} (f : α → β) : free_ring α →+* free_ring β := lift (of ∘ f)

@[simp] theorem map_of {α : Type u} {β : Type v} (f : α → β) (x : α) :
    coe_fn (map f) (of x) = of (f x) :=
  lift_of (of ∘ f) x

end Mathlib


import .nonneg_rat

def mask (α : Type*) : Type := α → ℚ*

namespace mask

def of_func {α : Type} (f : α → ℚ*) : mask α := f
def func_of {α : Type} (m : mask α) : α → ℚ* := m

instance {α : Type} : has_zero (mask α) := ⟨λ_, 0⟩
instance {α : Type} : inhabited (mask α) := ⟨0⟩

lemma zero_def {α : Type} : (0 : mask α) = λ_ ,0 := by refl

def add {α : Type} (m m' : mask α) : mask α :=
  λa, m a + m' a

instance {α : Type} : has_add (mask α) := ⟨add⟩

lemma add_def {α : Type} (m m' : mask α) : m + m' = λa, m a + m' a := by refl

def le {α : Type} (m m' : mask α) : Prop :=
  ∀a, m a ≤ m' a

instance {α : Type} : has_le (mask α) := ⟨le⟩

lemma le_def {α : Type} (m m' : mask α) : m ≤ m' ↔ ∀a, m a ≤ m' a := by refl

theorem zero_add {α : Type} (m : mask α) : 0 + m = m := begin
  simp only [function.funext_iff],
  intro a,
  rw add_def,
  simp [zero_def],
end

theorem add_zero {α : Type} (m : mask α) : m + 0 = m := begin
  simp only [function.funext_iff],
  intro a,
  rw add_def,
  simp [zero_def],
end

theorem add_assoc {α : Type} (m₁ m₂ m₃ : mask α) : m₁ + m₂ + m₃ = m₁ + (m₂ + m₃) := begin
  simp only [add_def, function.funext_iff],
  intro a,
  exact nonneg_rat.add_assoc _ _ _,
end

theorem add_comm {α : Type} (m m' : mask α) : m + m' = m' + m := begin
  simp only [add_def, function.funext_iff],
  intro a,
  exact nonneg_rat.add_comm _ _,
end

theorem add_left_cancel {α : Type} (l m m' : mask α) : l + m = l + m' → m = m' := begin
  simp only [add_def, function.funext_iff],
  intros all_left a,
  exact nonneg_rat.add_left_cancel _ _ _ (all_left a),
end

theorem add_right_cancel {α : Type} (m r m' : mask α) : m + r = m' + r → m = m' := begin
  simp only [add_def, function.funext_iff],
  intros all_right a,
  exact nonneg_rat.add_right_cancel _ _ _ (all_right a),
end

theorem le_refl {α : Type} (m : mask α) : m ≤ m := by rw le_def; intro a; exact nonneg_rat.le_refl (m a)
theorem le_trans {α : Type} (a b c : mask α) : a ≤ b → b ≤ c → a ≤ c := begin
  simp only [le_def],
  intro h_ab,
  intro h_bc,
  intro x,
  exact nonneg_rat.le_trans (a x) (b x) (c x) (h_ab x) (h_bc x),
end
theorem le_antisymm {α : Type} (a b : mask α) : a ≤ b → b ≤ a → a = b := begin
  simp only [le_def],
  intro h_ab,
  intro h_ba,
  rw function.funext_iff,
  intro x,
  exact nonneg_rat.le_antisymm (a x) (b x) (h_ab x) (h_ba x),
end

theorem add_le_add_left {α : Type} (m m' : mask α) : m ≤ m' → ∀l, l + m ≤ l + m' := begin
  simp only [le_def, add_def],
  intros all_leq l a,
  apply nonneg_rat.add_le_add_left,
  exact all_leq a,
end

theorem le_of_add_le_add_left {α : Type} (l m m' : mask α) : l + m ≤ l + m' → m ≤ m' := begin
  simp only [le_def, add_def],
  intros all_left a,
  exact nonneg_rat.le_of_add_le_add_left _ _ _ (all_left a),
end

instance {α : Type} : ordered_cancel_add_comm_monoid (mask α) :=
{
  zero := 0,
  add := add,
  le := le,

  zero_add := zero_add,
  add_zero := add_zero,

  add_assoc := add_assoc,
  add_comm := add_comm,

  add_left_cancel := add_left_cancel,
  add_right_cancel := add_right_cancel,

  le_refl := le_refl,
  le_trans := le_trans,
  le_antisymm := le_antisymm,

  add_le_add_left := add_le_add_left,
  le_of_add_le_add_left := le_of_add_le_add_left,
}

end mask


/-
Copyright (c) 2022 James Gallicchio.

Authors: James Gallicchio
-/

set_option pp.match false

namespace Stream

variable [Stream ρ τ] (s : ρ)

def drop (s : ρ) : Nat → ρ
| 0 => s
| n+1 =>
  match next? s with
  | none => s
  | some (_,rest) =>
    drop rest n

def isEmpty : Bool :=
  Option.isNone (next? s)

theorem drop_empty (n : Nat) :
  isEmpty s → drop s n = s
  := by
  intro h
  match h_next : next? s with
  | some _ =>
    simp [isEmpty, Option.isNone, h_next] at h
  | none =>
    cases n <;> simp [drop, h_next]

theorem drop_adds [Stream ρ τ] (s : ρ) (n₁ n₂ : Nat) :
  drop (drop s n₁) n₂ = drop s (n₁ + n₂)
  := by
  simp
  induction n₁ generalizing s
  case zero =>
    simp [drop]
  case succ n ih =>
    match h : next? s with
    | none =>
      have : isEmpty s := by simp [isEmpty, Option.isNone, h]
      simp [drop_empty _ _ this]
    | some ⟨_,s'⟩ =>
      rw [Nat.succ_add _ _]
      simp [drop, h]
      exact ih s'

def lengthBoundedBy (n : Nat) : Prop :=
  isEmpty (drop s n)

def hasNext : ρ → ρ → Prop
  := λ s1 s2 => ∃ x, next? s1 = some ⟨x,s2⟩

theorem lengthStep {s1 s2 : ρ} (h_steps : hasNext s1 s2)
                    {n : Nat} (h_len : lengthBoundedBy s1 n.succ)
  : lengthBoundedBy s2 n
  := by
  cases h_steps; case intro x h_steps =>
  simp [lengthBoundedBy, drop, h_steps] at h_len
  assumption

def isFinite : Prop :=
  ∃ n, lengthBoundedBy s n

end Stream

class FinStream (ρ : Type u) (τ : outParam (Type v))
  extends Stream ρ τ where
  h_finite : (s : ρ) → Stream.isFinite s

class SizedStream (ρ : Type u) (τ : outParam (Type v))
  extends FinStream ρ τ where
  size : ρ → Nat
  h_size s : Stream.lengthBoundedBy s (size s)
  h_finite s := ⟨size s, h_size s⟩

namespace FinStream
open Stream

instance hasNextWF [FinStream ρ τ] : WellFoundedRelation ρ where
  rel := λ s1 s2 => hasNext s2 s1
  wf := ⟨λ s => ⟨s, by
    cases FinStream.h_finite s; case intro w h =>
    induction w generalizing s
    case zero =>
      intro s' h_next
      apply False.elim
      simp [hasNext] at h_next
      cases h_next; case intro x h_next =>
      simp [lengthBoundedBy, drop, isEmpty, Option.isNone, h_next] at h
    case succ n ih =>
      intro s' h_next
      suffices lengthBoundedBy s' n from
        Acc.intro s' (ih s' this)
      simp [hasNext] at h_next
      cases h_next; case intro _ h_next =>
      simp [lengthBoundedBy, drop, h_next] at h ⊢
      assumption
  ⟩⟩

end FinStream