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

! This file was ported from Lean 3 source module group_theory.torsion
! leanprover-community/mathlib commit 1f4705ccdfe1e557fc54a0ce081a05e33d2e6240
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Exponent
import Mathbin.GroupTheory.OrderOfElement
import Mathbin.GroupTheory.PGroup
import Mathbin.GroupTheory.QuotientGroup
import Mathbin.GroupTheory.Submonoid.Operations

/-!
# Torsion groups

This file defines torsion groups, i.e. groups where all elements have finite order.

## Main definitions

* `monoid.is_torsion` a predicate asserting `G` is torsion, i.e. that all
  elements are of finite order.
* `comm_group.torsion G`, the torsion subgroup of an abelian group `G`
* `comm_monoid.torsion G`, the above stated for commutative monoids
* `monoid.is_torsion_free`, asserting no nontrivial elements have finite order in `G`
* `add_monoid.is_torsion` and `add_monoid.is_torsion_free` the additive versions of the above

## Implementation

All torsion monoids are really groups (which is proven here as `monoid.is_torsion.group`), but since
the definition can be stated on monoids it is implemented on `monoid` to match other declarations in
the group theory library.

## Tags

periodic group, aperiodic group, torsion subgroup, torsion abelian group

## Future work

* generalize to π-torsion(-free) groups for a set of primes π
* free, free solvable and free abelian groups are torsion free
* complete direct and free products of torsion free groups are torsion free
* groups which are residually finite p-groups with respect to 2 distinct primes are torsion free
-/

variable {G H : Type _}

namespace Monoid

variable (G) [Monoid G]

/-- A predicate on a monoid saying that all elements are of finite order. -/
@[to_additive "A predicate on an additive monoid saying that all elements are of finite order."]
def IsTorsion :=
  ∀ g : G, IsOfFinOrder g
#align monoid.is_torsion Monoid.IsTorsion
#align add_monoid.is_torsion AddMonoid.IsTorsion

/-- A monoid is not a torsion monoid if it has an element of infinite order. -/
@[simp,
  to_additive "An additive monoid is not a torsion monoid if it has an element of infinite order."]
theorem not_isTorsion_iff : ¬IsTorsion G ↔ ∃ g : G, ¬IsOfFinOrder g := by
  rw [is_torsion, not_forall]
#align monoid.not_is_torsion_iff Monoid.not_isTorsion_iff
#align add_monoid.not_is_torsion_iff AddMonoid.not_isTorsion_iff

end Monoid

open Monoid

/-- Torsion monoids are really groups. -/
@[to_additive "Torsion additive monoids are really additive groups"]
noncomputable def IsTorsion.group [Monoid G] (tG : IsTorsion G) : Group G :=
  { ‹Monoid G› with
    inv := fun g => g ^ (orderOf g - 1)
    mul_left_inv := fun g =>
      by
      erw [← pow_succ', tsub_add_cancel_of_le, pow_orderOf_eq_one]
      exact orderOf_pos' (tG g) }
#align is_torsion.group IsTorsion.group
#align is_torsion.add_group IsTorsion.addGroup

section Group

variable [Group G] {N : Subgroup G} [Group H]

/-- Subgroups of torsion groups are torsion groups. -/
@[to_additive "Subgroups of additive torsion groups are additive torsion groups."]
theorem IsTorsion.subgroup (tG : IsTorsion G) (H : Subgroup G) : IsTorsion H := fun h =>
  (isOfFinOrder_iff_coe H.toSubmonoid h).mpr <| tG h
#align is_torsion.subgroup IsTorsion.subgroup
#align is_torsion.add_subgroup IsTorsion.add_subgroup

/-- The image of a surjective torsion group homomorphism is torsion. -/
@[to_additive AddIsTorsion.of_surjective
      "The image of a surjective additive torsion group homomorphism is torsion."]
theorem IsTorsion.of_surjective {f : G →* H} (hf : Function.Surjective f) (tG : IsTorsion G) :
    IsTorsion H := fun h => by
  obtain ⟨g, hg⟩ := hf h
  rw [← hg]
  exact f.is_of_fin_order (tG g)
#align is_torsion.of_surjective IsTorsion.of_surjective
#align add_is_torsion.of_surjective AddIsTorsion.of_surjective

/-- Torsion groups are closed under extensions. -/
@[to_additive AddIsTorsion.extension_closed "Additive torsion groups are closed under extensions."]
theorem IsTorsion.extension_closed {f : G →* H} (hN : N = f.ker) (tH : IsTorsion H)
    (tN : IsTorsion N) : IsTorsion G := fun g =>
  (isOfFinOrder_iff_pow_eq_one _).mpr <|
    by
    obtain ⟨ngn, ngnpos, hngn⟩ := (isOfFinOrder_iff_pow_eq_one _).mp (tH <| f g)
    have hmem := f.mem_ker.mpr ((f.map_pow g ngn).trans hngn)
    lift g ^ ngn to N using hN.symm ▸ hmem with gn
    obtain ⟨nn, nnpos, hnn⟩ := (isOfFinOrder_iff_pow_eq_one _).mp (tN gn)
    exact
      ⟨ngn * nn, mul_pos ngnpos nnpos, by
        rw [pow_mul, ← h, ← Subgroup.coe_pow, hnn, Subgroup.coe_one]⟩
#align is_torsion.extension_closed IsTorsion.extension_closed
#align add_is_torsion.extension_closed AddIsTorsion.extension_closed

/-- The image of a quotient is torsion iff the group is torsion. -/
@[to_additive AddIsTorsion.quotient_iff
      "The image of a quotient is additively torsion iff the group is torsion."]
theorem IsTorsion.quotient_iff {f : G →* H} (hf : Function.Surjective f) (hN : N = f.ker)
    (tN : IsTorsion N) : IsTorsion H ↔ IsTorsion G :=
  ⟨fun tH => IsTorsion.extension_closed hN tH tN, fun tG => IsTorsion.of_surjective hf tG⟩
#align is_torsion.quotient_iff IsTorsion.quotient_iff
#align add_is_torsion.quotient_iff AddIsTorsion.quotient_iff

/-- If a group exponent exists, the group is torsion. -/
@[to_additive ExponentExists.is_add_torsion
      "If a group exponent exists, the group is additively torsion."]
theorem ExponentExists.isTorsion (h : ExponentExists G) : IsTorsion G := fun g =>
  by
  obtain ⟨n, npos, hn⟩ := h
  exact (isOfFinOrder_iff_pow_eq_one g).mpr ⟨n, npos, hn g⟩
#align exponent_exists.is_torsion ExponentExists.isTorsion
#align exponent_exists.is_add_torsion ExponentExists.is_add_torsion

/-- The group exponent exists for any bounded torsion group. -/
@[to_additive IsAddTorsion.exponentExists
      "The group exponent exists for any bounded additive torsion group."]
theorem IsTorsion.exponentExists (tG : IsTorsion G)
    (bounded : (Set.range fun g : G => orderOf g).Finite) : ExponentExists G :=
  exponentExists_iff_ne_zero.mpr <|
    (exponent_ne_zero_iff_range_orderOf_finite fun g => orderOf_pos' (tG g)).mpr bounded
#align is_torsion.exponent_exists IsTorsion.exponentExists
#align is_add_torsion.exponent_exists IsAddTorsion.exponentExists

/-- Finite groups are torsion groups. -/
@[to_additive is_add_torsion_of_finite "Finite additive groups are additive torsion groups."]
theorem isTorsion_of_finite [Finite G] : IsTorsion G :=
  ExponentExists.isTorsion <| exponentExists_iff_ne_zero.mpr exponent_ne_zero_of_finite
#align is_torsion_of_finite isTorsion_of_finite
#align is_add_torsion_of_finite is_add_torsion_of_finite

end Group

section Module

-- A (semi/)ring of scalars and a commutative monoid of elements
variable (R M : Type _) [AddCommMonoid M]

namespace AddMonoid

/-- A module whose scalars are additively torsion is additively torsion. -/
theorem IsTorsion.module_of_torsion [Semiring R] [Module R M] (tR : IsTorsion R) : IsTorsion M :=
  fun f =>
  (isOfFinAddOrder_iff_nsmul_eq_zero _).mpr <|
    by
    obtain ⟨n, npos, hn⟩ := (isOfFinAddOrder_iff_nsmul_eq_zero _).mp (tR 1)
    exact ⟨n, npos, by simp only [nsmul_eq_smul_cast R _ f, ← nsmul_one, hn, zero_smul]⟩
#align add_monoid.is_torsion.module_of_torsion AddMonoid.IsTorsion.module_of_torsion

/-- A module with a finite ring of scalars is additively torsion. -/
theorem IsTorsion.module_of_finite [Ring R] [Finite R] [Module R M] : IsTorsion M :=
  (is_add_torsion_of_finite : IsTorsion R).module_of_torsion _ _
#align add_monoid.is_torsion.module_of_finite AddMonoid.IsTorsion.module_of_finite

end AddMonoid

end Module

section CommMonoid

variable (G) [CommMonoid G]

namespace CommMonoid

/-- The torsion submonoid of a commutative monoid.

(Note that by `monoid.is_torsion.group` torsion monoids are truthfully groups.)
-/
@[to_additive add_torsion "The torsion submonoid of an additive commutative monoid."]
def torsion : Submonoid G where
  carrier := { x | IsOfFinOrder x }
  one_mem' := isOfFinOrder_one
  mul_mem' _ _ hx hy := hx.mul hy
#align comm_monoid.torsion CommMonoid.torsion
#align add_comm_monoid.add_torsion AddCommMonoid.addTorsion

variable {G}

/-- Torsion submonoids are torsion. -/
@[to_additive "Additive torsion submonoids are additively torsion."]
theorem torsion.isTorsion : IsTorsion <| torsion G := fun ⟨_, n, npos, hn⟩ =>
  ⟨n, npos,
    Subtype.ext <| by
      rw [mul_left_iterate, _root_.mul_one, [anonymous], Subtype.coe_mk, Submonoid.coe_one,
        (isPeriodicPt_mul_iff_pow_eq_one _).mp hn]⟩
#align comm_monoid.torsion.is_torsion CommMonoid.torsion.isTorsion
#align add_comm_monoid.add_torsion.is_torsion AddCommMonoid.addTorsion.is_torsion

variable (G) (p : ℕ) [hp : Fact p.Prime]

include hp

/-- The `p`-primary component is the submonoid of elements with order prime-power of `p`. -/
@[to_additive
      "The `p`-primary component is the submonoid of elements with additive order prime-power of `p`.",
  simps]
def primaryComponent : Submonoid G
    where
  carrier := { g | ∃ n : ℕ, orderOf g = p ^ n }
  one_mem' := ⟨0, by rw [pow_zero, orderOf_one]⟩
  mul_mem' g₁ g₂ hg₁ hg₂ :=
    exists_orderOf_eq_prime_pow_iff.mpr <|
      by
      obtain ⟨m, hm⟩ := exists_order_of_eq_prime_pow_iff.mp hg₁
      obtain ⟨n, hn⟩ := exists_order_of_eq_prime_pow_iff.mp hg₂
      exact
        ⟨m + n, by
          rw [mul_pow, pow_add, pow_mul, hm, one_pow, Monoid.one_mul, mul_comm, pow_mul, hn,
            one_pow]⟩
#align comm_monoid.primary_component CommMonoid.primaryComponent
#align add_comm_monoid.primary_component AddCommMonoid.primaryComponent

variable {G} {p}

/-- Elements of the `p`-primary component have order `p^n` for some `n`. -/
@[to_additive "Elements of the `p`-primary component have additive order `p^n` for some `n`"]
theorem primaryComponent.exists_orderOf_eq_prime_pow (g : CommMonoid.primaryComponent G p) :
    ∃ n : ℕ, orderOf g = p ^ n := by simpa [primary_component] using g.property
#align comm_monoid.primary_component.exists_order_of_eq_prime_pow CommMonoid.primaryComponent.exists_orderOf_eq_prime_pow
#align add_comm_monoid.primary_component.exists_order_of_eq_prime_nsmul AddCommMonoid.primaryComponent.exists_order_of_eq_prime_nsmul

/-- The `p`- and `q`-primary components are disjoint for `p ≠ q`. -/
@[to_additive "The `p`- and `q`-primary components are disjoint for `p ≠ q`."]
theorem primaryComponent.disjoint {p' : ℕ} [hp' : Fact p'.Prime] (hne : p ≠ p') :
    Disjoint (CommMonoid.primaryComponent G p) (CommMonoid.primaryComponent G p') :=
  Submonoid.disjoint_def.mpr <| by
    rintro g ⟨_ | n, hn⟩ ⟨n', hn'⟩
    · rwa [pow_zero, orderOf_eq_one_iff] at hn
    ·
      exact
        absurd (eq_of_prime_pow_eq hp.out.prime hp'.out.prime n.succ_pos (hn.symm.trans hn')) hne
#align comm_monoid.primary_component.disjoint CommMonoid.primaryComponent.disjoint
#align add_comm_monoid.primary_component.disjoint AddCommMonoid.primaryComponent.disjoint

end CommMonoid

open CommMonoid (torsion)

namespace Monoid.IsTorsion

variable {G}

/-- The torsion submonoid of a torsion monoid is `⊤`. -/
@[simp, to_additive "The additive torsion submonoid of an additive torsion monoid is `⊤`."]
theorem torsion_eq_top (tG : IsTorsion G) : torsion G = ⊤ := by ext <;> tauto
#align monoid.is_torsion.torsion_eq_top Monoid.IsTorsion.torsion_eq_top
#align add_monoid.is_torsion.torsion_eq_top AddMonoid.IsTorsion.torsion_eq_top

/-- A torsion monoid is isomorphic to its torsion submonoid. -/
@[to_additive "An additive torsion monoid is isomorphic to its torsion submonoid."]
def torsionMulEquiv (tG : IsTorsion G) : torsion G ≃* G :=
  (MulEquiv.submonoidCongr tG.torsion_eq_top).trans Submonoid.topEquiv
#align monoid.is_torsion.torsion_mul_equiv Monoid.IsTorsion.torsionMulEquiv
#align add_monoid.is_torsion.torsion_add_equiv AddMonoid.IsTorsion.torsionAddEquiv

@[to_additive]
theorem torsionMulEquiv_apply (tG : IsTorsion G) (a : torsion G) :
    tG.torsionMulEquiv a = MulEquiv.submonoidCongr tG.torsion_eq_top a :=
  rfl
#align monoid.is_torsion.torsion_mul_equiv_apply Monoid.IsTorsion.torsionMulEquiv_apply
#align add_monoid.is_torsion.torsion_add_equiv_apply AddMonoid.IsTorsion.torsion_add_equiv_apply

@[to_additive]
theorem torsionMulEquiv_symm_apply_coe (tG : IsTorsion G) (a : G) :
    tG.torsionMulEquiv.symm a = ⟨Submonoid.topEquiv.symm a, tG _⟩ :=
  rfl
#align monoid.is_torsion.torsion_mul_equiv_symm_apply_coe Monoid.IsTorsion.torsionMulEquiv_symm_apply_coe
#align add_monoid.is_torsion.torsion_add_equiv_symm_apply_coe AddMonoid.IsTorsion.torsion_add_equiv_symm_apply_coe

end Monoid.IsTorsion

/-- Torsion submonoids of a torsion submonoid are isomorphic to the submonoid. -/
@[simp,
  to_additive AddCommMonoid.Torsion.ofTorsion
      "Additive torsion submonoids of an additive torsion submonoid are isomorphic to the submonoid."]
def Torsion.ofTorsion : torsion (torsion G) ≃* torsion G :=
  Monoid.IsTorsion.torsionMulEquiv CommMonoid.torsion.isTorsion
#align torsion.of_torsion Torsion.ofTorsion
#align add_comm_monoid.torsion.of_torsion AddCommMonoid.Torsion.ofTorsion

end CommMonoid

section CommGroup

variable (G) [CommGroup G]

namespace CommGroup

/-- The torsion subgroup of an abelian group. -/
@[to_additive "The torsion subgroup of an additive abelian group."]
def torsion : Subgroup G :=
  { CommMonoid.torsion G with inv_mem' := fun x => IsOfFinOrder.inv }
#align comm_group.torsion CommGroup.torsion
#align add_comm_group.torsion AddCommGroup.torsion

/-- The torsion submonoid of an abelian group equals the torsion subgroup as a submonoid. -/
@[to_additive add_torsion_eq_add_torsion_submonoid
      "The additive torsion submonoid of an abelian group equals the torsion subgroup as a submonoid."]
theorem torsion_eq_torsion_submonoid : CommMonoid.torsion G = (torsion G).toSubmonoid :=
  rfl
#align comm_group.torsion_eq_torsion_submonoid CommGroup.torsion_eq_torsion_submonoid
#align add_comm_group.add_torsion_eq_add_torsion_submonoid AddCommGroup.add_torsion_eq_add_torsion_submonoid

variable (p : ℕ) [hp : Fact p.Prime]

include hp

/-- The `p`-primary component is the subgroup of elements with order prime-power of `p`. -/
@[to_additive
      "The `p`-primary component is the subgroup of elements with additive order prime-power of `p`.",
  simps]
def primaryComponent : Subgroup G :=
  { CommMonoid.primaryComponent G p with
    inv_mem' := fun g ⟨n, hn⟩ => ⟨n, (orderOf_inv g).trans hn⟩ }
#align comm_group.primary_component CommGroup.primaryComponent
#align add_comm_group.primary_component AddCommGroup.primaryComponent

variable {G} {p}

/-- The `p`-primary component is a `p` group. -/
theorem primaryComponent.isPGroup : IsPGroup p <| primaryComponent G p := fun g =>
  (propext exists_orderOf_eq_prime_pow_iff.symm).mpr
    (CommMonoid.primaryComponent.exists_orderOf_eq_prime_pow g)
#align comm_group.primary_component.is_p_group CommGroup.primaryComponent.isPGroup

end CommGroup

end CommGroup

namespace Monoid

variable (G) [Monoid G]

/-- A predicate on a monoid saying that only 1 is of finite order. -/
@[to_additive "A predicate on an additive monoid saying that only 0 is of finite order."]
def IsTorsionFree :=
  ∀ g : G, g ≠ 1 → ¬IsOfFinOrder g
#align monoid.is_torsion_free Monoid.IsTorsionFree
#align add_monoid.is_torsion_free AddMonoid.IsTorsionFree

/-- A nontrivial monoid is not torsion-free if any nontrivial element has finite order. -/
@[simp,
  to_additive "An additive monoid is not torsion free if any nontrivial element has finite order."]
theorem not_isTorsionFree_iff : ¬IsTorsionFree G ↔ ∃ g : G, g ≠ 1 ∧ IsOfFinOrder g := by
  simp_rw [is_torsion_free, Ne.def, not_forall, Classical.not_not, exists_prop]
#align monoid.not_is_torsion_free_iff Monoid.not_isTorsionFree_iff
#align add_monoid.not_is_torsion_free_iff AddMonoid.not_isTorsionFree_iff

end Monoid

section Group

open Monoid

variable [Group G]

/-- A nontrivial torsion group is not torsion-free. -/
@[to_additive AddMonoid.IsTorsion.not_torsion_free
      "A nontrivial additive torsion group is not torsion-free."]
theorem IsTorsion.not_torsion_free [hN : Nontrivial G] : IsTorsion G → ¬IsTorsionFree G := fun tG =>
  (not_isTorsionFree_iff _).mpr <|
    by
    obtain ⟨x, hx⟩ := (nontrivial_iff_exists_ne (1 : G)).mp hN
    exact ⟨x, hx, tG x⟩
#align is_torsion.not_torsion_free IsTorsion.not_torsion_free
#align add_monoid.is_torsion.not_torsion_free AddMonoid.IsTorsion.not_torsion_free

/-- A nontrivial torsion-free group is not torsion. -/
@[to_additive AddMonoid.IsTorsionFree.not_torsion
      "A nontrivial torsion-free additive group is not torsion."]
theorem IsTorsionFree.not_torsion [hN : Nontrivial G] : IsTorsionFree G → ¬IsTorsion G := fun tfG =>
  (not_isTorsion_iff _).mpr <|
    by
    obtain ⟨x, hx⟩ := (nontrivial_iff_exists_ne (1 : G)).mp hN
    exact ⟨x, (tfG x) hx⟩
#align is_torsion_free.not_torsion IsTorsionFree.not_torsion
#align add_monoid.is_torsion_free.not_torsion AddMonoid.IsTorsionFree.not_torsion

/-- Subgroups of torsion-free groups are torsion-free. -/
@[to_additive "Subgroups of additive torsion-free groups are additively torsion-free."]
theorem IsTorsionFree.subgroup (tG : IsTorsionFree G) (H : Subgroup G) : IsTorsionFree H :=
  fun h hne =>
  (isOfFinOrder_iff_coe H.toSubmonoid h).Not.mpr <|
    tG h <| by norm_cast <;> simp [hne, not_false_iff]
#align is_torsion_free.subgroup IsTorsionFree.subgroup
#align is_torsion_free.add_subgroup IsTorsionFree.add_subgroup

/-- Direct products of torsion free groups are torsion free. -/
@[to_additive AddMonoid.IsTorsionFree.prod
      "Direct products of additive torsion free groups are torsion free."]
theorem IsTorsionFree.prod {η : Type _} {Gs : η → Type _} [∀ i, Group (Gs i)]
    (tfGs : ∀ i, IsTorsionFree (Gs i)) : IsTorsionFree <| ∀ i, Gs i := fun w hne h =>
  hne <|
    funext fun i => Classical.not_not.mp <| mt (tfGs i (w i)) <| Classical.not_not.mpr <| h.apply i
#align is_torsion_free.prod IsTorsionFree.prod
#align add_monoid.is_torsion_free.prod AddMonoid.IsTorsionFree.prod

end Group

section CommGroup

open Monoid (IsTorsionFree)

open CommGroup (torsion)

variable (G) [CommGroup G]

/-- Quotienting a group by its torsion subgroup yields a torsion free group. -/
@[to_additive AddIsTorsionFree.quotient_torsion
      "Quotienting a group by its additive torsion subgroup yields an additive torsion free group."]
theorem IsTorsionFree.quotient_torsion : IsTorsionFree <| G ⧸ torsion G := fun g hne hfin =>
  hne <| by
    induction g using QuotientGroup.induction_on'
    obtain ⟨m, mpos, hm⟩ := (isOfFinOrder_iff_pow_eq_one _).mp hfin
    obtain ⟨n, npos, hn⟩ := (isOfFinOrder_iff_pow_eq_one _).mp ((QuotientGroup.eq_one_iff _).mp hm)
    exact
      (QuotientGroup.eq_one_iff g).mpr
        ((isOfFinOrder_iff_pow_eq_one _).mpr ⟨m * n, mul_pos mpos npos, (pow_mul g m n).symm ▸ hn⟩)
#align is_torsion_free.quotient_torsion IsTorsionFree.quotient_torsion
#align add_is_torsion_free.quotient_torsion AddIsTorsionFree.quotient_torsion

end CommGroup


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Yury Kudryashov
-/
import data.set.lattice

/-!
# Extra lemmas about intervals

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

This file contains lemmas about intervals that cannot be included into `data.set.intervals.basic`
because this would create an `import` cycle. Namely, lemmas in this file can use definitions
from `data.set.lattice`, including `disjoint`.
-/

universes u v w

variables {ι : Sort u} {α : Type v} {β : Type w}

open set order_dual (to_dual)

namespace set

section preorder
variables [preorder α] {a b c : α}

@[simp] lemma Iic_disjoint_Ioi (h : a ≤ b) : disjoint (Iic a) (Ioi b) :=
disjoint_left.mpr $ λ x ha hb, (h.trans_lt hb).not_le ha

@[simp] lemma Iic_disjoint_Ioc (h : a ≤ b) : disjoint (Iic a) (Ioc b c) :=
(Iic_disjoint_Ioi h).mono le_rfl (λ _, and.left)

@[simp] lemma Ioc_disjoint_Ioc_same {a b c : α} : disjoint (Ioc a b) (Ioc b c) :=
(Iic_disjoint_Ioc (le_refl b)).mono (λ _, and.right) le_rfl

@[simp] lemma Ico_disjoint_Ico_same {a b c : α} : disjoint (Ico a b) (Ico b c) :=
disjoint_left.mpr $ λ x hab hbc, hab.2.not_le hbc.1

@[simp] lemma Ici_disjoint_Iic : disjoint (Ici a) (Iic b) ↔ ¬(a ≤ b) :=
by rw [set.disjoint_iff_inter_eq_empty, Ici_inter_Iic, Icc_eq_empty_iff]

@[simp] lemma Iic_disjoint_Ici : disjoint (Iic a) (Ici b) ↔ ¬(b ≤ a) :=
disjoint.comm.trans Ici_disjoint_Iic

@[simp] lemma Union_Iic : (⋃ a : α, Iic a) = univ := Union_eq_univ_iff.2 $ λ x, ⟨x, right_mem_Iic⟩
@[simp] lemma Union_Ici : (⋃ a : α, Ici a) = univ := Union_eq_univ_iff.2 $ λ x, ⟨x, left_mem_Ici⟩

@[simp] lemma Union_Icc_right (a : α) : (⋃ b, Icc a b) = Ici a :=
by simp only [← Ici_inter_Iic, ← inter_Union, Union_Iic, inter_univ]

@[simp] lemma Union_Ioc_right (a : α) : (⋃ b, Ioc a b) = Ioi a :=
by simp only [← Ioi_inter_Iic, ← inter_Union, Union_Iic, inter_univ]

@[simp] lemma Union_Icc_left (b : α) : (⋃ a, Icc a b) = Iic b :=
by simp only [← Ici_inter_Iic, ← Union_inter, Union_Ici, univ_inter]

@[simp] lemma Union_Ico_left (b : α) : (⋃ a, Ico a b) = Iio b :=
by simp only [← Ici_inter_Iio, ← Union_inter, Union_Ici, univ_inter]

@[simp] lemma Union_Iio [no_max_order α] : (⋃ a : α, Iio a) = univ :=
Union_eq_univ_iff.2 exists_gt

@[simp] lemma Union_Ioi [no_min_order α] : (⋃ a : α, Ioi a) = univ :=
Union_eq_univ_iff.2 exists_lt

@[simp] lemma Union_Ico_right [no_max_order α] (a : α) : (⋃ b, Ico a b) = Ici a :=
by simp only [← Ici_inter_Iio, ← inter_Union, Union_Iio, inter_univ]

@[simp] lemma Union_Ioo_right [no_max_order α] (a : α) : (⋃ b, Ioo a b) = Ioi a :=
by simp only [← Ioi_inter_Iio, ← inter_Union, Union_Iio, inter_univ]

@[simp] lemma Union_Ioc_left [no_min_order α] (b : α) : (⋃ a, Ioc a b) = Iic b :=
by simp only [← Ioi_inter_Iic, ← Union_inter, Union_Ioi, univ_inter]

@[simp] lemma Union_Ioo_left [no_min_order α] (b : α) : (⋃ a, Ioo a b) = Iio b :=
by simp only [← Ioi_inter_Iio, ← Union_inter, Union_Ioi, univ_inter]

end preorder

section linear_order
variables [linear_order α] {a₁ a₂ b₁ b₂ : α}

@[simp] lemma Ico_disjoint_Ico : disjoint (Ico a₁ a₂) (Ico b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
by simp_rw [set.disjoint_iff_inter_eq_empty, Ico_inter_Ico, Ico_eq_empty_iff,
  inf_eq_min, sup_eq_max, not_lt]

@[simp] lemma Ioc_disjoint_Ioc : disjoint (Ioc a₁ a₂) (Ioc b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ :=
have h : _ ↔ min (to_dual a₁) (to_dual b₁) ≤ max (to_dual a₂) (to_dual b₂) := Ico_disjoint_Ico,
by simpa only [dual_Ico] using h

/-- If two half-open intervals are disjoint and the endpoint of one lies in the other,
  then it must be equal to the endpoint of the other. -/
lemma eq_of_Ico_disjoint {x₁ x₂ y₁ y₂ : α}
  (h : disjoint (Ico x₁ x₂) (Ico y₁ y₂)) (hx : x₁ < x₂) (h2 : x₂ ∈ Ico y₁ y₂) :
  y₁ = x₂ :=
begin
  rw [Ico_disjoint_Ico, min_eq_left (le_of_lt h2.2), le_max_iff] at h,
  apply le_antisymm h2.1,
  exact h.elim (λ h, absurd hx (not_lt_of_le h)) id
end

@[simp] lemma Union_Ico_eq_Iio_self_iff {f : ι → α} {a : α} :
  (⋃ i, Ico (f i) a) = Iio a ↔ ∀ x < a, ∃ i, f i ≤ x :=
by simp [← Ici_inter_Iio, ← Union_inter, subset_def]

@[simp] lemma Union_Ioc_eq_Ioi_self_iff {f : ι → α} {a : α} :
  (⋃ i, Ioc a (f i)) = Ioi a ↔ ∀ x, a < x → ∃ i, x ≤ f i :=
by simp [← Ioi_inter_Iic, ← inter_Union, subset_def]

@[simp] lemma bUnion_Ico_eq_Iio_self_iff {p : ι → Prop} {f : Π i, p i → α} {a : α} :
  (⋃ i (hi : p i), Ico (f i hi) a) = Iio a ↔ ∀ x < a, ∃ i hi, f i hi ≤ x :=
by simp [← Ici_inter_Iio, ← Union_inter, subset_def]

@[simp]

end linear_order

end set

section Union_Ixx

variables [linear_order α] {s : set α} {a : α} {f : ι → α}

lemma is_glb.bUnion_Ioi_eq (h : is_glb s a) : (⋃ x ∈ s, Ioi x) = Ioi a :=
begin
  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
  { exact Ioi_subset_Ioi (h.1 hx) },
  { rcases h.exists_between hx with ⟨y, hys, hay, hyx⟩,
    exact mem_bUnion hys hyx }
end

lemma is_glb.Union_Ioi_eq (h : is_glb (range f) a) :
  (⋃ x, Ioi (f x)) = Ioi a :=
bUnion_range.symm.trans h.bUnion_Ioi_eq

lemma is_lub.bUnion_Iio_eq (h : is_lub s a) :
  (⋃ x ∈ s, Iio x) = Iio a :=
h.dual.bUnion_Ioi_eq

lemma is_lub.Union_Iio_eq (h : is_lub (range f) a) :
  (⋃ x, Iio (f x)) = Iio a :=
h.dual.Union_Ioi_eq

lemma is_glb.bUnion_Ici_eq_Ioi (a_glb : is_glb s a) (a_not_mem : a ∉ s) :
  (⋃ x ∈ s, Ici x) = Ioi a :=
begin
  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
  { exact Ici_subset_Ioi.mpr (lt_of_le_of_ne (a_glb.1 hx) (λ h, (h ▸ a_not_mem) hx)), },
  { rcases a_glb.exists_between hx with ⟨y, hys, hay, hyx⟩,
    apply mem_Union₂.mpr ,
    refine ⟨y, hys, hyx.le⟩, },
end

lemma is_glb.bUnion_Ici_eq_Ici (a_glb : is_glb s a) (a_mem : a ∈ s) :
  (⋃ x ∈ s, Ici x) = Ici a :=
begin
  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
  { exact Ici_subset_Ici.mpr (mem_lower_bounds.mp a_glb.1 x hx), },
  { apply mem_Union₂.mpr,
    refine ⟨a, a_mem, hx⟩, },
end

lemma is_lub.bUnion_Iic_eq_Iio (a_lub : is_lub s a) (a_not_mem : a ∉ s) :
  (⋃ x ∈ s, Iic x) = Iio a :=
a_lub.dual.bUnion_Ici_eq_Ioi a_not_mem

lemma is_lub.bUnion_Iic_eq_Iic (a_lub : is_lub s a) (a_mem : a ∈ s) :
  (⋃ x ∈ s, Iic x) = Iic a :=
a_lub.dual.bUnion_Ici_eq_Ici a_mem

lemma Union_Ici_eq_Ioi_infi {R : Type*} [complete_linear_order R]
  {f : ι → R} (no_least_elem : (⨅ i, f i) ∉ range f) :
  (⋃ (i : ι), Ici (f i)) = Ioi (⨅ i, f i) :=
by simp only [← is_glb.bUnion_Ici_eq_Ioi (@is_glb_infi _ _ _ f) no_least_elem,
              mem_range, Union_exists, Union_Union_eq']

lemma Union_Iic_eq_Iio_supr {R : Type*} [complete_linear_order R]
  {f : ι → R} (no_greatest_elem : (⨆ i, f i) ∉ range f) :
  (⋃ (i : ι), Iic (f i)) = Iio (⨆ i, f i) :=
@Union_Ici_eq_Ioi_infi ι (order_dual R) _ f no_greatest_elem

lemma Union_Ici_eq_Ici_infi {R : Type*} [complete_linear_order R]
  {f : ι → R} (has_least_elem : (⨅ i, f i) ∈ range f) :
  (⋃ (i : ι), Ici (f i)) = Ici (⨅ i, f i) :=
by simp only [← is_glb.bUnion_Ici_eq_Ici (@is_glb_infi _ _ _ f) has_least_elem,
              mem_range, Union_exists, Union_Union_eq']

lemma Union_Iic_eq_Iic_supr {R : Type*} [complete_linear_order R]
  {f : ι → R} (has_greatest_elem : (⨆ i, f i) ∈ range f) :
  (⋃ (i : ι), Iic (f i)) = Iic (⨆ i, f i) :=
@Union_Ici_eq_Ici_infi ι (order_dual R) _ f has_greatest_elem

end Union_Ixx


import .path
import .graph_induction

-- from math 688 notes, lec-19

universe u
variables (V : Type u)

-- TO DO:
    -- define components (they are used twice here), give them some lemmas
    -- prove that removing a vertex from a tree results in a graph whose components are trees with smaller size
    -- concrete development of the category of graphs so we can prove useful properties (see Hedetniemi branch)

-- might be useful:
    -- `finset.eq_singleton_iff_unique_mem` says `s = {a} ↔ a ∈ s ∧ ∀ x ∈ s, x = a`

open_locale classical

namespace simple_graph

-- create some sort of type coercion for edges in subgraph and supergraph

variables {V} (T : simple_graph V) (a b : V) --(S : simple_graph (λ v, v ≠ a))

#check T.adj a b

def connected : Prop := ∀ (a b : V), ∃ (p : T.path), a = p.head ∧ b = p.last

def acyclic : Prop := ∀ (p : T.path), ¬ p.simple_cycle

class tree : Prop :=
(connected : connected T)
(acyclic : acyclic T)
#check T.connected

--def tree : Prop := connected T ∧ acyclic T

def leaf (v : V) [fintype (T.neighbor_set v)] : Prop := T.degree v = 1

variables [∀ v, fintype (T.neighbor_set v)] [tree T] (p : path T)

#check fintype.card

-- move this to simple_graph later (need to prove that `p.is_tour` and therefore `p.is_maximal` exists in any finite simple graph)
lemma fin_max_path [fintype V] (h : 2 ≤ fintype.card V) : ∃ (p : path T), p.is_maximal :=
begin

    -- show that if the number of vertices is finite then the path lengths are all finite
    -- use the fact that you have an upper bound for sets of integers
    /-have h2 := fintype.exists_pair_of_one_lt_card h,
    cases h2 with a hb,
    cases hb with b h3,-/ -- don't think we want to pick arbitrary a and b
    --have h4 := T.connected,
    -- we're gonna need the bijection (λ (p : path), p.length) in order to find a maximum because then we can find a finite set on ℕ

    sorry,
end

/- Theorem 1: every tree on n ≥ 2 vertices contains at least two vertices of degree 1 -/
lemma two_deg_one [fintype V] (h : 2 ≤ fintype.card V) : ∃ (v₁ v₂ : V), v₁ ≠ v₂ ∧ T.leaf v₁ ∧ T.leaf v₂ :=
begin
    -- Proof outline:
    have h2 := fintype.exists_pair_of_one_lt_card h,
    cases h2 with a hb,
    cases hb with b h3,
    use a,
    use b,
    split,
    exact h3,

    split,
    -- let p = x0 x1 ... xk in T be a maximal path in tree T
        -- Sub-lemma : prove that maximal paths exist
        -- use `p.tail.length` (number of edges in `p`)
    -- assume for contradiction that we have some neighbor y of x0, where y ≠ x1. this gives us two cases:
        -- either y is contained in a path that links back up with the original path, so acyclicity is violated
        -- or y is contained in a path that does not link back up, which then makes that new path an extension of the original, so maximality of p is violated
            -- `p.cons e hp hs` is the path extending `p` by edge `e`.
            -- (these two things should probably be their own lemmas so we can just apply them to x0 and xk)
    -- so then x0 does not have any neighbors besides x1, and therefore has degree 1
    -- similar argument goes for xk, which gives us at least two vertices in T that are leaves
    sorry,
    sorry,
end

/- Theorem 2: if T is a tree on n ≥ 2 vertices and x is a leaf, then the graph obtained by removing x from T is a tree on n - 1 vertices -/
-- this should probably be made with more general lemmas
section other
lemma acyclic_subgraph_acyclic (t : acyclic T) (s : set V) : acyclic (induced_subgraph V T s) :=
begin
    -- Proof outline:
    -- T has no cycles so T \ {x} has no cycles
    sorry,
end -- generalize to any subgraph once that's defined

variable (x : V)

--vertex_mem (v : V) (p : G.path) : Prop := v ∈ p.vertices

-- is this actually useful? who knows
/-lemma leaf_path_endpoint (p : T.path) (h1 : T.leaf x) (h2 : x ∈ p.vertices) : p.head = x ∨ p.last = x :=
begin
    -- `rw mem_neighbor_finset` says `w ∈ G.neighbor_finset v ↔ G.adj v w`
    unfold leaf at h1,
    unfold degree at h1,
    rw finset.card_eq_one at h1,
    cases h1 with w hw,
    rw finset.eq_singleton_iff_unique_mem at hw,
    cases hw with hm hu,
    -- reverse (head :: tail) to, well, reverse it
    -- list.head (list.reverse (head :: tail) is the new list head
    sorry,
end-/

lemma connected_rmleaf_connected (t : connected T) {x : V} (h : T.leaf x) : connected (induced_subgraph V T (λ v, v ≠ x)) :=
begin
    -- Proof outline:
    -- there are uv paths for all u v in T

    -- if T.leaf x and x ∈ p, x must either be p.head or p.last ?
        -- should this be its own sub-lemma?
    -- T.connected means there are paths from every vertex to every vertex
    unfold connected,
    unfold connected at t,
    intros h1 h2,
    sorry,
end

end other

instance tree_rmleaf_is_tree {x : V} (h : T.leaf x) : tree (induced_subgraph V T (λ v, v ≠ x)) :=
{ connected := T.connected_rmleaf_connected tree.connected h,
  acyclic := T.acyclic_subgraph_acyclic tree.acyclic _
}

/- Theorem 3: TFAE
    (a) T is a tree
    (b) There exists a unique path between any two distinct vertices of T
    (c) T is a connected graph on n vertices with n-1 edges
    (d) T is an acyclic graph on n vertices with n-1 edges -/

-- Proof outline:
/- Lemma 1: (a) → (b) : T is a tree → there exists a unique path between any two distinct vertices -/
lemma tree_unique_path [inhabited V] (t : tree T) (u v : V) (p : T.path) (q : T.path) : (p.head = q.head) ∧ (p.last = q.last) → p = q :=
begin
-- Subproof outline:
    -- let u,v be distinct vertices in T
    -- T is a tree, so a uv path p exists
        -- we already have uv path guaranteed by definition of tree
    intro h,
    cases h with hh hl,
    rw path.eq_of_vertices_eq,
    -- suppose for contradiction that another path uv path q exists, p ≠ q (negation of eq_of_vertices_eq?)
    by_contra,
    -- there exists w s.t. w ∈ p and w ∈ q, where w is the last vertex before p and q diverge (maybe make a lemma for this)
        -- shit this is gonna be tricky
        -- (this doesn't cover the edge case that u is adjacent to v, which is false by the condition that we have a simple graph. this is a problem. fix the definition somehow)
    -- p.last = q.last, so we must have a vertex w' in p,q (could be v) such that (figure out how to say this correctly) w'.tail ∈ p ∧ w'.tail ∈ q (also this should probably be a path lemma)
    -- now, this means that we can build a path from w back to itself using the segments w to w' in p and q (do we have reversible paths in path.lean?)
    sorry,
end

/- Lemma 2: (b) → (c) : there exists a unique path between any two distinct vertices → T is connected on n vertices with n - 1 edges -/
-- note: no mention of T being a tree here, so that's not one of our assumptions (and can be used on any simple graph i think)
-- Subproof outline: (strong induction on V.card)
    -- Base Case: trivially true for V.card = 1, but that's because we have no edges
        -- this might be a problem - if we don't have loops, how can we say the individual vertex has a path to itself?
        -- maybe need to show it's true for V.card = 2?
    -- IH: assume the statement holds for V.card < n vertices
    -- let V.card = n
    -- let u,v be distinct vertices in T
    -- by assumption, a uv path p exists
    -- since p is unique, removing an edge x from p (and in fact the edge set of T. maybe new induced subgraph definition?) disconnects u from v
    -- the resultant graph contains two components H and K on vertex sets U and W, where U.card < n and W.card < n, so by IH we have U.card - 1 edges in H and W.card - 1 edges in K, and U.card + W.card = n - 1, which gives us n - 2 edges in H ∪ K. then adding back x, we have n - 1 edges in T.

/- Lemma 3: (c) → (d) : T is connected on n vertices with n - 1 edges → T is acyclic on n vertices with n - 1 edges -/
-- note: no mention of T being a tree here, so that's not one of our assumptions (and can be used on any simple graph)
-- Subproof outline:
    -- suppose for contradiction that T has a cycle C of length k ≥ 3.
    -- C contains k vertices and k edges (i think there are lemmas for this in path.lean)
    -- since k ≤ n (by (c)), there are n - k vertices in T that are not in C
    -- ∀ v : V, v ∉ C
        -- consider a path connecting v to a vertex in C
        -- each path will have at least 1 edge
        -- the number of edges connecting the rest of the vertices in V to those in C is at least n - k
        -- this means we have n - k + k = n ≤ edges in T, which is a contradiction

/- Lemma 4: (d) → (a) : T is acyclic on n vertices with n - 1 edges → T is a tree -/
-- note: this time we want to prove that T is a tree, so that's not one of our assumptions (and can be used on any simple graph)
-- Subproof outline:
    -- T is acyclic, V.card = n
    -- suppose T has k ≥ 1 components T1, T2, ... , Tk (oh boy finset time)
    -- since T is acyclic and components are connected, each Ti is a tree (say they're on Vi, and Vi.card = ni)
    -- since each Ti is a tree, we can use (a) → (b) → (c) to get that each Ti has ni - 1 edges
    -- therefore, T has ∑ (ni - 1) = (∑ ni) - k = n - k edges
    -- since n - k = n - 1, we have k = 1, so we have 1 component (which is connected by definition of component)
    -- the one component is all of T (make this a lemma about components)
    -- therefore T is acyclic and connected, and must be a tree

-- i guess make a bunch of iff lemmas out of that so i can rw stuff

-- make Prüfer codes

end simple_graph


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.mean_value
import Mathlib.analysis.special_functions.exp_log
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Grönwall's inequality

The main technical result of this file is the Grönwall-like inequality
`norm_le_gronwall_bound_of_norm_deriv_right_le`. It states that if `f : ℝ → E` satisfies `∥f a∥ ≤ δ`
and `∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then for all `x ∈ [a, b]` we have `∥f x∥ ≤ δ * exp (K *
x) + (ε / K) * (exp (K * x) - 1)`.

Then we use this inequality to prove some estimates on the possible rate of growth of the distance
between two approximate or exact solutions of an ordinary differential equation.

The proofs are based on [Hubbard and West, *Differential Equations: A Dynamical Systems Approach*,
Sec. 4.5][HubbardWest-ode], where `norm_le_gronwall_bound_of_norm_deriv_right_le` is called
“Fundamental Inequality”.

## TODO

- Once we have FTC, prove an inequality for a function satisfying `∥f' x∥ ≤ K x * ∥f x∥ + ε`,
  or more generally `liminf_{y→x+0} (f y - f x)/(y - x) ≤ K x * f x + ε` with any sign
  of `K x` and `f x`.
-/

/-! ### Technical lemmas about `gronwall_bound` -/

/-- Upper bound used in several Grönwall-like inequalities. -/
def gronwall_bound (δ : ℝ) (K : ℝ) (ε : ℝ) (x : ℝ) : ℝ :=
  ite (K = 0) (δ + ε * x) (δ * real.exp (K * x) + ε / K * (real.exp (K * x) - 1))

theorem gronwall_bound_K0 (δ : ℝ) (ε : ℝ) : gronwall_bound δ 0 ε = fun (x : ℝ) => δ + ε * x :=
  funext fun (x : ℝ) => if_pos rfl

theorem gronwall_bound_of_K_ne_0 {δ : ℝ} {K : ℝ} {ε : ℝ} (hK : K ≠ 0) : gronwall_bound δ K ε = fun (x : ℝ) => δ * real.exp (K * x) + ε / K * (real.exp (K * x) - 1) :=
  funext fun (x : ℝ) => if_neg hK

theorem has_deriv_at_gronwall_bound (δ : ℝ) (K : ℝ) (ε : ℝ) (x : ℝ) : has_deriv_at (gronwall_bound δ K ε) (K * gronwall_bound δ K ε x + ε) x := sorry

theorem has_deriv_at_gronwall_bound_shift (δ : ℝ) (K : ℝ) (ε : ℝ) (x : ℝ) (a : ℝ) : has_deriv_at (fun (y : ℝ) => gronwall_bound δ K ε (y - a)) (K * gronwall_bound δ K ε (x - a) + ε) x := sorry

theorem gronwall_bound_x0 (δ : ℝ) (K : ℝ) (ε : ℝ) : gronwall_bound δ K ε 0 = δ := sorry

theorem gronwall_bound_ε0 (δ : ℝ) (K : ℝ) (x : ℝ) : gronwall_bound δ K 0 x = δ * real.exp (K * x) := sorry

theorem gronwall_bound_ε0_δ0 (K : ℝ) (x : ℝ) : gronwall_bound 0 K 0 x = 0 := sorry

theorem gronwall_bound_continuous_ε (δ : ℝ) (K : ℝ) (x : ℝ) : continuous fun (ε : ℝ) => gronwall_bound δ K ε x := sorry

/-! ### Inequality and corollaries -/

/-- A Grönwall-like inequality: if `f : ℝ → ℝ` is continuous on `[a, b]` and satisfies
the inequalities `f a ≤ δ` and
`∀ x ∈ [a, b), liminf_{z→x+0} (f z - f x)/(z - x) ≤ K * (f x) + ε`, then `f x`
is bounded by `gronwall_bound δ K ε (x - a)` on `[a, b]`.

See also `norm_le_gronwall_bound_of_norm_deriv_right_le` for a version bounding `∥f x∥`,
`f : ℝ → E`. -/
theorem le_gronwall_bound_of_liminf_deriv_right_le {f : ℝ → ℝ} {f' : ℝ → ℝ} {δ : ℝ} {K : ℝ} {ε : ℝ} {a : ℝ} {b : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (x : ℝ),
  x ∈ set.Ico a b →
    ∀ (r : ℝ), f' x < r → filter.frequently (fun (z : ℝ) => z - x⁻¹ * (f z - f x) < r) (nhds_within x (set.Ioi x))) (ha : f a ≤ δ) (bound : ∀ (x : ℝ), x ∈ set.Ico a b → f' x ≤ K * f x + ε) (x : ℝ) (H : x ∈ set.Icc a b) : f x ≤ gronwall_bound δ K ε (x - a) := sorry

/-- A Grönwall-like inequality: if `f : ℝ → E` is continuous on `[a, b]`, has right derivative
`f' x` at every point `x ∈ [a, b)`, and satisfies the inequalities `∥f a∥ ≤ δ`,
`∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then `∥f x∥` is bounded by `gronwall_bound δ K ε (x - a)`
on `[a, b]`. -/
theorem norm_le_gronwall_bound_of_norm_deriv_right_le {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : ℝ → E} {f' : ℝ → E} {δ : ℝ} {K : ℝ} {ε : ℝ} {a : ℝ} {b : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (x : ℝ), x ∈ set.Ico a b → has_deriv_within_at f (f' x) (set.Ici x) x) (ha : norm (f a) ≤ δ) (bound : ∀ (x : ℝ), x ∈ set.Ico a b → norm (f' x) ≤ K * norm (f x) + ε) (x : ℝ) (H : x ∈ set.Icc a b) : norm (f x) ≤ gronwall_bound δ K ε (x - a) := sorry

/-- If `f` and `g` are two approximate solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in some time-dependent set `s t`,
and assumes that the solutions never leave this set. -/
theorem dist_le_of_approx_trajectories_ODE_of_mem_set {E : Type u_1} [normed_group E] [normed_space ℝ E] {v : ℝ → E → E} {s : ℝ → set E} {K : ℝ} (hv : ∀ (t : ℝ) (x y : E), x ∈ s t → y ∈ s t → dist (v t x) (v t y) ≤ K * dist x y) {f : ℝ → E} {g : ℝ → E} {f' : ℝ → E} {g' : ℝ → E} {a : ℝ} {b : ℝ} {εf : ℝ} {εg : ℝ} {δ : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at f (f' t) (set.Ici t) t) (f_bound : ∀ (t : ℝ), t ∈ set.Ico a b → dist (f' t) (v t (f t)) ≤ εf) (hfs : ∀ (t : ℝ), t ∈ set.Ico a b → f t ∈ s t) (hg : continuous_on g (set.Icc a b)) (hg' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at g (g' t) (set.Ici t) t) (g_bound : ∀ (t : ℝ), t ∈ set.Ico a b → dist (g' t) (v t (g t)) ≤ εg) (hgs : ∀ (t : ℝ), t ∈ set.Ico a b → g t ∈ s t) (ha : dist (f a) (g a) ≤ δ) (t : ℝ) (H : t ∈ set.Icc a b) : dist (f t) (g t) ≤ gronwall_bound δ K (εf + εg) (t - a) := sorry

/-- If `f` and `g` are two approximate solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in the whole space. -/
theorem dist_le_of_approx_trajectories_ODE {E : Type u_1} [normed_group E] [normed_space ℝ E] {v : ℝ → E → E} {K : nnreal} (hv : ∀ (t : ℝ), lipschitz_with K (v t)) {f : ℝ → E} {g : ℝ → E} {f' : ℝ → E} {g' : ℝ → E} {a : ℝ} {b : ℝ} {εf : ℝ} {εg : ℝ} {δ : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at f (f' t) (set.Ici t) t) (f_bound : ∀ (t : ℝ), t ∈ set.Ico a b → dist (f' t) (v t (f t)) ≤ εf) (hg : continuous_on g (set.Icc a b)) (hg' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at g (g' t) (set.Ici t) t) (g_bound : ∀ (t : ℝ), t ∈ set.Ico a b → dist (g' t) (v t (g t)) ≤ εg) (ha : dist (f a) (g a) ≤ δ) (t : ℝ) (H : t ∈ set.Icc a b) : dist (f t) (g t) ≤ gronwall_bound δ (↑K) (εf + εg) (t - a) := sorry

/-- If `f` and `g` are two exact solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in some time-dependent set `s t`,
and assumes that the solutions never leave this set. -/
theorem dist_le_of_trajectories_ODE_of_mem_set {E : Type u_1} [normed_group E] [normed_space ℝ E] {v : ℝ → E → E} {s : ℝ → set E} {K : ℝ} (hv : ∀ (t : ℝ) (x y : E), x ∈ s t → y ∈ s t → dist (v t x) (v t y) ≤ K * dist x y) {f : ℝ → E} {g : ℝ → E} {a : ℝ} {b : ℝ} {δ : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at f (v t (f t)) (set.Ici t) t) (hfs : ∀ (t : ℝ), t ∈ set.Ico a b → f t ∈ s t) (hg : continuous_on g (set.Icc a b)) (hg' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at g (v t (g t)) (set.Ici t) t) (hgs : ∀ (t : ℝ), t ∈ set.Ico a b → g t ∈ s t) (ha : dist (f a) (g a) ≤ δ) (t : ℝ) (H : t ∈ set.Icc a b) : dist (f t) (g t) ≤ δ * real.exp (K * (t - a)) := sorry

/-- If `f` and `g` are two exact solutions of the same ODE, then the distance between them
can't grow faster than exponentially. This is a simple corollary of Grönwall's inequality, and some
people call this Grönwall's inequality too.

This version assumes all inequalities to be true in the whole space. -/
theorem dist_le_of_trajectories_ODE {E : Type u_1} [normed_group E] [normed_space ℝ E] {v : ℝ → E → E} {K : nnreal} (hv : ∀ (t : ℝ), lipschitz_with K (v t)) {f : ℝ → E} {g : ℝ → E} {a : ℝ} {b : ℝ} {δ : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at f (v t (f t)) (set.Ici t) t) (hg : continuous_on g (set.Icc a b)) (hg' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at g (v t (g t)) (set.Ici t) t) (ha : dist (f a) (g a) ≤ δ) (t : ℝ) (H : t ∈ set.Icc a b) : dist (f t) (g t) ≤ δ * real.exp (↑K * (t - a)) := sorry

/-- There exists only one solution of an ODE \(\dot x=v(t, x)\) in a set `s ⊆ ℝ × E` with
a given initial value provided that RHS is Lipschitz continuous in `x` within `s`,
and we consider only solutions included in `s`. -/
theorem ODE_solution_unique_of_mem_set {E : Type u_1} [normed_group E] [normed_space ℝ E] {v : ℝ → E → E} {s : ℝ → set E} {K : ℝ} (hv : ∀ (t : ℝ) (x y : E), x ∈ s t → y ∈ s t → dist (v t x) (v t y) ≤ K * dist x y) {f : ℝ → E} {g : ℝ → E} {a : ℝ} {b : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at f (v t (f t)) (set.Ici t) t) (hfs : ∀ (t : ℝ), t ∈ set.Ico a b → f t ∈ s t) (hg : continuous_on g (set.Icc a b)) (hg' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at g (v t (g t)) (set.Ici t) t) (hgs : ∀ (t : ℝ), t ∈ set.Ico a b → g t ∈ s t) (ha : f a = g a) (t : ℝ) (H : t ∈ set.Icc a b) : f t = g t :=
  eq.mp (Eq._oldrec (Eq.refl (dist (f t) (g t) ≤ 0)) (propext dist_le_zero))
    (eq.mp (Eq._oldrec (Eq.refl (dist (f t) (g t) ≤ 0 * real.exp (K * (t - a)))) (zero_mul (real.exp (K * (t - a)))))
      (dist_le_of_trajectories_ODE_of_mem_set hv hf hf' hfs hg hg' hgs (iff.mpr dist_le_zero ha) t ht))

/-- There exists only one solution of an ODE \(\dot x=v(t, x)\) with
a given initial value provided that RHS is Lipschitz continuous in `x`. -/
theorem ODE_solution_unique {E : Type u_1} [normed_group E] [normed_space ℝ E] {v : ℝ → E → E} {K : nnreal} (hv : ∀ (t : ℝ), lipschitz_with K (v t)) {f : ℝ → E} {g : ℝ → E} {a : ℝ} {b : ℝ} (hf : continuous_on f (set.Icc a b)) (hf' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at f (v t (f t)) (set.Ici t) t) (hg : continuous_on g (set.Icc a b)) (hg' : ∀ (t : ℝ), t ∈ set.Ico a b → has_deriv_within_at g (v t (g t)) (set.Ici t) t) (ha : f a = g a) (t : ℝ) (H : t ∈ set.Icc a b) : f t = g t := sorry


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebra.group
import algebra.group_power.basic
import algebra.iterate_hom

/-!
# Regular elements

We introduce left-regular, right-regular and regular elements.

By definition, a regular element in a commutative ring is a non-zero divisor.
Lemma `is_regular_of_ne_zero` implies that every non-zero element of an integral domain is regular.
Since it assumes that the ring is a `cancel_monoid_with_zero` it applies also, for instance, to `ℕ`.

The lemmas in Section `mul_zero_class` show that the `0` element is (left/right-)regular if and
only if the `mul_zero_class` is trivial.  This is useful when figuring out stopping conditions for
regular sequences: if `0` is ever an element of a regular sequence, then we can extend the sequence
by adding one further `0`.

The final goal is to develop part of the API to prove, eventually, results about non-zero-divisors.
-/
variables {R : Type*} {a b : R}

section has_mul

variable [has_mul R]

/-- A left-regular element is an element `c` such that multiplication on the left by `c`
is injective on the left. -/
def is_left_regular (c : R) := function.injective ((*) c)

/-- A right-regular element is an element `c` such that multiplication on the right by `c`
is injective on the right. -/
def is_right_regular (c : R) := function.injective (* c)

/-- A regular element is an element `c` such that multiplication by `c` both on the left and
on the right is injective. -/
structure is_regular (c : R) : Prop :=
(left : is_left_regular c)
(right : is_right_regular c)

end has_mul

section semigroup

variable [semigroup R]

/-- In a semigroup, the product of left-regular elements is left-regular. -/
lemma is_left_regular.mul (lra : is_left_regular a) (lrb : is_left_regular b) :
  is_left_regular (a * b) :=
show function.injective ((*) (a * b)), from (comp_mul_left a b) ▸ lra.comp lrb

/-- In a semigroup, the product of right-regular elements is right-regular. -/
lemma is_right_regular.mul (rra : is_right_regular a) (rrb : is_right_regular b) :
  is_right_regular (a * b) :=
show function.injective (* (a * b)), from (comp_mul_right b a) ▸ rrb.comp rra

/--  If an element `b` becomes left-regular after multiplying it on the left by a left-regular
element, then `b` is left-regular. -/
lemma is_left_regular.of_mul (ab : is_left_regular (a * b)) :
  is_left_regular b :=
function.injective.of_comp (by rwa comp_mul_left a b)

/--  An element is left-regular if and only if multiplying it on the left by a left-regular element
is left-regular. -/
@[simp] lemma mul_is_left_regular_iff (b : R) (ha : is_left_regular a) :
  is_left_regular (a * b) ↔ is_left_regular b :=
⟨λ ab, is_left_regular.of_mul ab, λ ab, is_left_regular.mul ha ab⟩

/--  If an element `b` becomes right-regular after multiplying it on the right by a right-regular
element, then `b` is right-regular. -/
lemma is_right_regular.of_mul (ab : is_right_regular (b * a)) :
  is_right_regular b :=
begin
  refine λ x y xy, ab (_ : x * (b * a) = y * (b * a)),
  rw [← mul_assoc, ← mul_assoc],
  exact congr_fun (congr_arg has_mul.mul xy) a,
end

/--  An element is right-regular if and only if multiplying it on the right with a right-regular
element is right-regular. -/
@[simp] lemma mul_is_right_regular_iff (b : R) (ha : is_right_regular a) :
  is_right_regular (b * a) ↔ is_right_regular b :=
⟨λ ab, is_right_regular.of_mul ab, λ ab, is_right_regular.mul ab ha⟩

/--  Two elements `a` and `b` are regular if and only if both products `a * b` and `b * a`
are regular. -/
lemma is_regular_mul_and_mul_iff :
  is_regular (a * b) ∧ is_regular (b * a) ↔ is_regular a ∧ is_regular b :=
begin
  refine ⟨_, _⟩,
  { rintros ⟨ab, ba⟩,
    exact ⟨⟨is_left_regular.of_mul ba.left, is_right_regular.of_mul ab.right⟩,
      ⟨is_left_regular.of_mul ab.left, is_right_regular.of_mul ba.right⟩⟩ },
  { rintros ⟨ha, hb⟩,
    exact ⟨⟨(mul_is_left_regular_iff _ ha.left).mpr hb.left,
        (mul_is_right_regular_iff _ hb.right).mpr ha.right⟩,
      ⟨(mul_is_left_regular_iff _ hb.left).mpr ha.left,
        (mul_is_right_regular_iff _ ha.right).mpr hb.right⟩⟩ }
end

/--  The "most used" implication of `mul_and_mul_iff`, with split hypotheses, instead of `∧`. -/
lemma is_regular.and_of_mul_of_mul (ab : is_regular (a * b)) (ba : is_regular (b * a)) :
  is_regular a ∧ is_regular b :=
is_regular_mul_and_mul_iff.mp ⟨ab, ba⟩

end semigroup

section monoid

variable [monoid R]

/--  Any power of a left-regular element is left-regular. -/
lemma is_left_regular.pow (n : ℕ) (rla : is_left_regular a) : is_left_regular (a ^ n) :=
by simp only [is_left_regular, ← mul_left_iterate, rla.iterate n]

/--  Any power of a right-regular element is right-regular. -/
lemma is_right_regular.pow (n : ℕ) (rra : is_right_regular a) : is_right_regular (a ^ n) :=
by { rw [is_right_regular, ← mul_right_iterate], exact rra.iterate n }

/--  Any power of a regular element is regular. -/
lemma is_regular.pow (n : ℕ) (ra : is_regular a) : is_regular (a ^ n) :=
⟨is_left_regular.pow n ra.left, is_right_regular.pow n ra.right⟩

/--  An element `a` is left-regular if and only if a positive power of `a` is left-regular. -/
lemma is_left_regular.pow_iff {n : ℕ} (n0 : 0 < n) :
  is_left_regular (a ^ n) ↔ is_left_regular a :=
begin
  refine ⟨_, is_left_regular.pow n⟩,
  rw [← nat.succ_pred_eq_of_pos n0, pow_succ'],
  exact is_left_regular.of_mul,
end

/--  An element `a` is right-regular if and only if a positive power of `a` is right-regular. -/
lemma is_right_regular.pow_iff {n : ℕ} (n0 : 0 < n) :
  is_right_regular (a ^ n) ↔ is_right_regular a :=
begin
  refine ⟨_, is_right_regular.pow n⟩,
  rw [← nat.succ_pred_eq_of_pos n0, pow_succ],
  exact is_right_regular.of_mul,
end

/--  An element `a` is regular if and only if a positive power of `a` is regular. -/
lemma is_regular.pow_iff {n : ℕ} (n0 : 0 < n) :
  is_regular (a ^ n) ↔ is_regular a :=
⟨λ h, ⟨(is_left_regular.pow_iff n0).mp h.left, (is_right_regular.pow_iff n0).mp h.right⟩,
  λ h, ⟨is_left_regular.pow n h.left, is_right_regular.pow n h.right⟩⟩

end monoid

section mul_zero_class

variables [mul_zero_class R]

/--  The element `0` is left-regular if and only if `R` is trivial. -/
lemma is_left_regular.subsingleton (h : is_left_regular (0 : R)) : subsingleton R :=
⟨λ a b, h $ eq.trans (zero_mul a) (zero_mul b).symm⟩

/--  The element `0` is right-regular if and only if `R` is trivial. -/
lemma is_right_regular.subsingleton (h : is_right_regular (0 : R)) : subsingleton R :=
⟨λ a b, h $ eq.trans (mul_zero a) (mul_zero b).symm⟩

/--  The element `0` is regular if and only if `R` is trivial. -/
lemma is_regular.subsingleton (h : is_regular (0 : R)) : subsingleton R :=
h.left.subsingleton

/--  The element `0` is left-regular if and only if `R` is trivial. -/
lemma is_left_regular_zero_iff_subsingleton : is_left_regular (0 : R) ↔ subsingleton R :=
begin
  refine ⟨λ h, h.subsingleton, _⟩,
  intros H a b h,
  exact @subsingleton.elim _ H a b
end

/--  In a non-trivial `mul_zero_class`, the `0` element is not left-regular. -/
lemma not_is_left_regular_zero_iff : ¬ is_left_regular (0 : R) ↔ nontrivial R :=
begin
  rw [nontrivial_iff, not_iff_comm, is_left_regular_zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/--  The element `0` is right-regular if and only if `R` is trivial. -/
lemma is_right_regular_zero_iff_subsingleton : is_right_regular (0 : R) ↔ subsingleton R :=
begin
  refine ⟨λ h, h.subsingleton, _⟩,
  intros H a b h,
  exact @subsingleton.elim _ H a b
end

/--  In a non-trivial `mul_zero_class`, the `0` element is not right-regular. -/
lemma not_is_right_regular_zero_iff : ¬ is_right_regular (0 : R) ↔ nontrivial R :=
begin
  rw [nontrivial_iff, not_iff_comm, is_right_regular_zero_iff_subsingleton, subsingleton_iff],
  push_neg,
  exact iff.rfl
end

/--  The element `0` is regular if and only if `R` is trivial. -/
lemma is_regular_iff_subsingleton : is_regular (0 : R) ↔ subsingleton R :=
⟨λ h, h.left.subsingleton,
 λ h, ⟨is_left_regular_zero_iff_subsingleton.mpr h, is_right_regular_zero_iff_subsingleton.mpr h⟩⟩

/-- A left-regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_left_regular.ne_zero [nontrivial R] (la : is_left_regular a) : a ≠ 0 :=
begin
  rintro rfl,
  rcases exists_pair_ne R with ⟨x, y, xy⟩,
  refine xy (la _),
  rw [zero_mul, zero_mul]
end

/-- A right-regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_right_regular.ne_zero [nontrivial R] (ra : is_right_regular a) : a ≠ 0 :=
begin
  rintro rfl,
  rcases exists_pair_ne R with ⟨x, y, xy⟩,
  refine xy (ra (_ : x * 0 = y * 0)),
  rw [mul_zero, mul_zero]
end

/-- A regular element of a `nontrivial` `mul_zero_class` is non-zero. -/
lemma is_regular.ne_zero [nontrivial R] (la : is_regular a) : a ≠ 0 :=
la.left.ne_zero

/--  In a non-trivial ring, the element `0` is not left-regular -- with typeclasses. -/
lemma not_is_left_regular_zero [nR : nontrivial R] : ¬ is_left_regular (0 : R) :=
not_is_left_regular_zero_iff.mpr nR

/--  In a non-trivial ring, the element `0` is not right-regular -- with typeclasses. -/
lemma not_is_right_regular_zero [nR : nontrivial R] : ¬ is_right_regular (0 : R) :=
not_is_right_regular_zero_iff.mpr nR

/--  In a non-trivial ring, the element `0` is not regular -- with typeclasses. -/
lemma not_is_regular_zero [nontrivial R] : ¬ is_regular (0 : R) :=
λ h, is_regular.ne_zero h rfl

end mul_zero_class

section comm_semigroup

variable [comm_semigroup R]

/--  A product is regular if and only if the factors are. -/
lemma is_regular_mul_iff : is_regular (a * b) ↔ is_regular a ∧ is_regular b :=
begin
  refine iff.trans _ is_regular_mul_and_mul_iff,
  refine ⟨λ ab, ⟨ab, by rwa mul_comm⟩, λ rab, rab.1⟩
end

end comm_semigroup

section monoid

variables [monoid R]

/--  In a monoid, `1` is regular. -/
lemma is_regular_one : is_regular (1 : R) :=
⟨λ a b ab, (one_mul a).symm.trans (eq.trans ab (one_mul b)),
  λ a b ab, (mul_one a).symm.trans (eq.trans ab (mul_one b))⟩

/-- An element admitting a left inverse is left-regular. -/
lemma is_left_regular_of_mul_eq_one (h : b * a = 1) : is_left_regular a :=
@is_left_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.left })

/-- An element admitting a right inverse is right-regular. -/
lemma is_right_regular_of_mul_eq_one (h : a * b = 1) : is_right_regular a :=
@is_right_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.right })

/-- If `R` is a monoid, an element in `units R` is regular. -/
lemma units.is_regular (a : units R) : is_regular (a : R) :=
⟨is_left_regular_of_mul_eq_one a.inv_mul, is_right_regular_of_mul_eq_one a.mul_inv⟩

/-- A unit in a monoid is regular. -/
lemma is_unit.is_regular (ua : is_unit a) : is_regular a :=
begin
  rcases ua with ⟨a, rfl⟩,
  exact units.is_regular a,
end

end monoid

section left_or_right_cancel_semigroup

/--  Elements of a left cancel semigroup are left regular. -/
lemma is_left_regular_of_left_cancel_semigroup [left_cancel_semigroup R] (g : R) :
  is_left_regular g :=
mul_right_injective g

/--  Elements of a right cancel semigroup are right regular. -/
lemma is_right_regular_of_right_cancel_semigroup [right_cancel_semigroup R] (g : R) :
  is_right_regular g :=
mul_left_injective g

end left_or_right_cancel_semigroup

section cancel_monoid

variables [cancel_monoid R]

/--  Elements of a cancel monoid are regular.  Cancel semigroups do not appear to exist. -/
lemma is_regular_of_cancel_monoid (g : R) : is_regular g :=
⟨mul_right_injective g, mul_left_injective g⟩

end cancel_monoid

section cancel_monoid_with_zero

variables  [cancel_monoid_with_zero R]

/--  Non-zero elements of an integral domain are regular. -/
lemma is_regular_of_ne_zero (a0 : a ≠ 0) : is_regular a :=
⟨λ b c, (mul_right_inj' a0).mp, λ b c, (mul_left_inj' a0).mp⟩

/-- In a non-trivial integral domain, an element is regular iff it is non-zero. -/
lemma is_regular_iff_ne_zero [nontrivial R] : is_regular a ↔ a ≠ 0 :=
⟨is_regular.ne_zero, is_regular_of_ne_zero⟩

end cancel_monoid_with_zero


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Utensil Song
-/

import algebra.ring_quot
import linear_algebra.tensor_algebra.basic
import linear_algebra.quadratic_form.isometry

/-!
# Clifford Algebras

We construct the Clifford algebra of a module `M` over a commutative ring `R`, equipped with
a quadratic_form `Q`.

## Notation

The Clifford algebra of the `R`-module `M` equipped with a quadratic_form `Q` is denoted as
`clifford_algebra Q`.

Given a linear morphism `f : M → A` from a module `M` to another `R`-algebra `A`, such that
`cond : ∀ m, f m * f m = algebra_map _ _ (Q m)`, there is a (unique) lift of `f` to an `R`-algebra
morphism, which is denoted `clifford_algebra.lift Q f cond`.

The canonical linear map `M → clifford_algebra Q` is denoted `clifford_algebra.ι Q`.

## Theorems

The main theorems proved ensure that `clifford_algebra Q` satisfies the universal property
of the Clifford algebra.
1. `ι_comp_lift` is the fact that the composition of `ι Q` with `lift Q f cond` agrees with `f`.
2. `lift_unique` ensures the uniqueness of `lift Q f cond` with respect to 1.

Additionally, when `Q = 0` an `alg_equiv` to the `exterior_algebra` is provided as `as_exterior`.

## Implementation details

The Clifford algebra of `M` is constructed as a quotient of the tensor algebra, as follows.
1. We define a relation `clifford_algebra.rel Q` on `tensor_algebra R M`.
   This is the smallest relation which identifies squares of elements of `M` with `Q m`.
2. The Clifford algebra is the quotient of the tensor algebra by this relation.

This file is almost identical to `linear_algebra/exterior_algebra.lean`.
-/

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables (Q : quadratic_form R M)

variable {n : ℕ}

namespace clifford_algebra
open tensor_algebra

/-- `rel` relates each `ι m * ι m`, for `m : M`, with `Q m`.

The Clifford algebra of `M` is defined as the quotient modulo this relation.
-/
inductive rel : tensor_algebra R M → tensor_algebra R M → Prop
| of (m : M) : rel (ι R m * ι R m) (algebra_map R _ (Q m))

end clifford_algebra

/--
The Clifford algebra of an `R`-module `M` equipped with a quadratic_form `Q`.
-/
@[derive [inhabited, ring, algebra R]]
def clifford_algebra := ring_quot (clifford_algebra.rel Q)

namespace clifford_algebra

/--
The canonical linear map `M →ₗ[R] clifford_algebra Q`.
-/
def ι : M →ₗ[R] clifford_algebra Q :=
(ring_quot.mk_alg_hom R _).to_linear_map.comp (tensor_algebra.ι R)

/-- As well as being linear, `ι Q` squares to the quadratic form -/
@[simp]
theorem ι_sq_scalar (m : M) : ι Q m * ι Q m = algebra_map R _ (Q m) :=
begin
  erw [←alg_hom.map_mul, ring_quot.mk_alg_hom_rel R (rel.of m), alg_hom.commutes],
  refl,
end

variables {Q} {A : Type*} [semiring A] [algebra R A]

@[simp]
theorem comp_ι_sq_scalar (g : clifford_algebra Q →ₐ[R] A) (m : M) :
  g (ι Q m) * g (ι Q m) = algebra_map _ _ (Q m) :=
by rw [←alg_hom.map_mul, ι_sq_scalar, alg_hom.commutes]

variables (Q)

/--
Given a linear map `f : M →ₗ[R] A` into an `R`-algebra `A`, which satisfies the condition:
`cond : ∀ m : M, f m * f m = Q(m)`, this is the canonical lift of `f` to a morphism of `R`-algebras
from `clifford_algebra Q` to `A`.
-/
@[simps symm_apply]
def lift :
  {f : M →ₗ[R] A // ∀ m, f m * f m = algebra_map _ _ (Q m)} ≃ (clifford_algebra Q →ₐ[R] A) :=
{ to_fun := λ f,
  ring_quot.lift_alg_hom R ⟨tensor_algebra.lift R (f : M →ₗ[R] A),
    (λ x y (h : rel Q x y), by
    { induction h,
      rw [alg_hom.commutes, alg_hom.map_mul, tensor_algebra.lift_ι_apply, f.prop], })⟩,
  inv_fun := λ F, ⟨F.to_linear_map.comp (ι Q), λ m, by rw [
    linear_map.comp_apply, alg_hom.to_linear_map_apply, comp_ι_sq_scalar]⟩,
  left_inv := λ f, by { ext,
    simp only [ι, alg_hom.to_linear_map_apply, function.comp_app, linear_map.coe_comp,
               subtype.coe_mk, ring_quot.lift_alg_hom_mk_alg_hom_apply,
               tensor_algebra.lift_ι_apply] },
  right_inv := λ F, by { ext,
    simp only [ι, alg_hom.comp_to_linear_map, alg_hom.to_linear_map_apply, function.comp_app,
               linear_map.coe_comp, subtype.coe_mk, ring_quot.lift_alg_hom_mk_alg_hom_apply,
               tensor_algebra.lift_ι_apply] } }

variables {Q}

@[simp]
theorem ι_comp_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = algebra_map _ _ (Q m)) :
  (lift Q ⟨f, cond⟩).to_linear_map.comp (ι Q) = f :=
(subtype.mk_eq_mk.mp $ (lift Q).symm_apply_apply ⟨f, cond⟩)

@[simp]
theorem lift_ι_apply (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = algebra_map _ _ (Q m)) (x) :
  lift Q ⟨f, cond⟩ (ι Q x) = f x :=
(linear_map.ext_iff.mp $ ι_comp_lift f cond) x

@[simp]
theorem lift_unique (f : M →ₗ[R] A) (cond : ∀ m : M, f m * f m = algebra_map _ _ (Q m))
  (g : clifford_algebra Q →ₐ[R] A) :
  g.to_linear_map.comp (ι Q) = f ↔ g = lift Q ⟨f, cond⟩ :=
begin
  convert (lift Q).symm_apply_eq,
  rw lift_symm_apply,
  simp only,
end

attribute [irreducible] clifford_algebra ι lift

@[simp]
theorem lift_comp_ι (g : clifford_algebra Q →ₐ[R] A) :
  lift Q ⟨g.to_linear_map.comp (ι Q), comp_ι_sq_scalar _⟩ = g :=
begin
  convert (lift Q).apply_symm_apply g,
  rw lift_symm_apply,
  refl,
end

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext {A : Type*} [semiring A] [algebra R A] {f g : clifford_algebra Q →ₐ[R] A} :
  f.to_linear_map.comp (ι Q) = g.to_linear_map.comp (ι Q) → f = g :=
begin
  intro h,
  apply (lift Q).symm.injective,
  rw [lift_symm_apply, lift_symm_apply],
  simp only [h],
end

/-- If `C` holds for the `algebra_map` of `r : R` into `clifford_algebra Q`, the `ι` of `x : M`,
and is preserved under addition and muliplication, then it holds for all of `clifford_algebra Q`.

See also the stronger `clifford_algebra.left_induction` and `clifford_algebra.right_induction`.
-/
-- This proof closely follows `tensor_algebra.induction`
@[elab_as_eliminator]
lemma induction {C : clifford_algebra Q → Prop}
  (h_grade0 : ∀ r, C (algebra_map R (clifford_algebra Q) r))
  (h_grade1 : ∀ x, C (ι Q x))
  (h_mul : ∀ a b, C a → C b → C (a * b))
  (h_add : ∀ a b, C a → C b → C (a + b))
  (a : clifford_algebra Q) :
  C a :=
begin
  -- the arguments are enough to construct a subalgebra, and a mapping into it from M
  let s : subalgebra R (clifford_algebra Q) :=
  { carrier := C,
    mul_mem' := h_mul,
    add_mem' := h_add,
    algebra_map_mem' := h_grade0, },
  let of : { f : M →ₗ[R] s // ∀ m, f m * f m = algebra_map _ _ (Q m) } :=
  ⟨(ι Q).cod_restrict s.to_submodule h_grade1,
    λ m, subtype.eq $ ι_sq_scalar Q m ⟩,
  -- the mapping through the subalgebra is the identity
  have of_id : alg_hom.id R (clifford_algebra Q) = s.val.comp (lift Q of),
  { ext,
    simp [of], },
  -- finding a proof is finding an element of the subalgebra
  convert subtype.prop (lift Q of a),
  exact alg_hom.congr_fun of_id a,
end

/-- The symmetric product of vectors is a scalar -/
lemma ι_mul_ι_add_swap (a b : M) :
  ι Q a * ι Q b + ι Q b * ι Q a = algebra_map R _ (quadratic_form.polar Q a b) :=
calc  ι Q a * ι Q b + ι Q b * ι Q a
    = ι Q (a + b) * ι Q (a + b) - ι Q a * ι Q a - ι Q b * ι Q b :
        by { rw [(ι Q).map_add, mul_add, add_mul, add_mul], abel, }
... = algebra_map R _ (Q (a + b)) - algebra_map R _ (Q a) - algebra_map R _ (Q b) :
        by rw [ι_sq_scalar, ι_sq_scalar, ι_sq_scalar]
... = algebra_map R _ (Q (a + b) - Q a - Q b) :
        by rw [←ring_hom.map_sub, ←ring_hom.map_sub]
... = algebra_map R _ (quadratic_form.polar Q a b) : rfl

@[simp]
lemma ι_range_map_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = algebra_map _ _ (Q m)) :
  (ι Q).range.map (lift Q ⟨f, cond⟩).to_linear_map = f.range :=
by rw [←linear_map.range_comp, ι_comp_lift]

section map

variables {M₁ M₂ M₃ : Type*}
variables [add_comm_group M₁] [add_comm_group M₂] [add_comm_group M₃]
variables [module R M₁] [module R M₂] [module R M₃]
variables (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) (Q₃ : quadratic_form R M₃)

/-- Any linear map that preserves the quadratic form lifts to an `alg_hom` between algebras.

See `clifford_algebra.equiv_of_isometry` for the case when `f` is a `quadratic_form.isometry`. -/
def map (f : M₁ →ₗ[R] M₂) (hf : ∀ m, Q₂ (f m) = Q₁ m) :
  clifford_algebra Q₁ →ₐ[R] clifford_algebra Q₂ :=
clifford_algebra.lift Q₁ ⟨(clifford_algebra.ι Q₂).comp f,
  λ m, (ι_sq_scalar _ _).trans $ ring_hom.congr_arg _ $ hf m⟩

@[simp]
lemma map_comp_ι (f : M₁ →ₗ[R] M₂) (hf) :
  (map Q₁ Q₂ f hf).to_linear_map.comp (ι Q₁) = (ι Q₂).comp f :=
ι_comp_lift _ _

@[simp]
lemma map_apply_ι (f : M₁ →ₗ[R] M₂) (hf) (m : M₁):
  map Q₁ Q₂ f hf (ι Q₁ m) = ι Q₂ (f m) :=
lift_ι_apply _ _ m

@[simp]
lemma map_id :
  map Q₁ Q₁ (linear_map.id : M₁ →ₗ[R] M₁) (λ m, rfl) = alg_hom.id R (clifford_algebra Q₁) :=
by { ext m, exact map_apply_ι _ _ _ _ m }

@[simp]
lemma map_comp_map (f : M₂ →ₗ[R] M₃) (hf) (g : M₁ →ₗ[R] M₂) (hg) :
  (map Q₂ Q₃ f hf).comp (map Q₁ Q₂ g hg) = map Q₁ Q₃ (f.comp g) (λ m, (hf _).trans $ hg m) :=
begin
  ext m,
  dsimp only [linear_map.comp_apply, alg_hom.comp_apply, alg_hom.to_linear_map_apply,
    alg_hom.id_apply],
  rw [map_apply_ι, map_apply_ι, map_apply_ι, linear_map.comp_apply],
end

@[simp]
lemma ι_range_map_map (f : M₁ →ₗ[R] M₂) (hf : ∀ m, Q₂ (f m) = Q₁ m) :
  (ι Q₁).range.map (map Q₁ Q₂ f hf).to_linear_map = f.range.map (ι Q₂) :=
(ι_range_map_lift _ _).trans (linear_map.range_comp _ _)

variables {Q₁ Q₂ Q₃}

/-- Two `clifford_algebra`s are equivalent as algebras if their quadratic forms are
equivalent. -/
@[simps apply]
def equiv_of_isometry (e : Q₁.isometry Q₂) :
  clifford_algebra Q₁ ≃ₐ[R] clifford_algebra Q₂ :=
alg_equiv.of_alg_hom
  (map Q₁ Q₂ e e.map_app)
  (map Q₂ Q₁ e.symm e.symm.map_app)
  ((map_comp_map _ _ _ _ _ _ _).trans $ begin
    convert map_id _ using 2,
    ext m,
    exact e.to_linear_equiv.apply_symm_apply m,
  end)
  ((map_comp_map _ _ _ _ _ _ _).trans $ begin
    convert map_id _ using 2,
    ext m,
    exact e.to_linear_equiv.symm_apply_apply m,
  end)

@[simp]
lemma equiv_of_isometry_symm (e : Q₁.isometry Q₂) :
  (equiv_of_isometry e).symm = equiv_of_isometry e.symm := rfl

@[simp]
lemma equiv_of_isometry_trans (e₁₂ : Q₁.isometry Q₂) (e₂₃ : Q₂.isometry Q₃) :
  (equiv_of_isometry e₁₂).trans (equiv_of_isometry e₂₃) = equiv_of_isometry (e₁₂.trans e₂₃) :=
by { ext x, exact alg_hom.congr_fun (map_comp_map Q₁ Q₂ Q₃ _ _ _ _) x }

@[simp]
lemma equiv_of_isometry_refl :
  (equiv_of_isometry $ quadratic_form.isometry.refl Q₁) = alg_equiv.refl :=
by { ext x, exact alg_hom.congr_fun (map_id Q₁) x }

end map

end clifford_algebra

namespace tensor_algebra

variables {Q}

/-- The canonical image of the `tensor_algebra` in the `clifford_algebra`, which maps
`tensor_algebra.ι R x` to `clifford_algebra.ι Q x`. -/
def to_clifford : tensor_algebra R M →ₐ[R] clifford_algebra Q :=
tensor_algebra.lift R (clifford_algebra.ι Q)

@[simp] lemma to_clifford_ι (m : M) : (tensor_algebra.ι R m).to_clifford = clifford_algebra.ι Q m :=
by simp [to_clifford]

end tensor_algebra


/-
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.approximations
import algebra.continued_fractions.computation.correctness_terminating
import data.rat
/-!
# Termination of Continued Fraction Computations (`gcf.of`)

## Summary
We show that the continued fraction for a value `v`, as defined in
`algebra.continued_fractions.computation.basic`, terminates if and only if `v` corresponds to a
rational number, that is `↑v = q` for some `q : ℚ`.

## Main Theorems

- `generalized_continued_fraction.coe_of_rat` shows that
  `generalized_continued_fraction.of v = generalized_continued_fraction.of q` for `v : α` given that
  `↑v = q` and `q : ℚ`.
- `generalized_continued_fraction.terminates_iff_rat` shows that
  `generalized_continued_fraction.of v` terminates if and only if `↑v = q` for some `q : ℚ`.

## Tags

rational, continued fraction, termination
-/

namespace generalized_continued_fraction
open generalized_continued_fraction as gcf

variables {K : Type*} [linear_ordered_field K] [floor_ring K]

/-
We will have to constantly coerce along our structures in the following proofs using their provided
map functions.
-/
local attribute [simp] gcf.pair.map gcf.int_fract_pair.mapFr

section rat_of_terminates
/-!
### Terminating Continued Fractions Are Rational

We want to show that the computation of a continued fraction `generalized_continued_fraction.of v`
terminates if and only if `v ∈ ℚ`. In this section, we show the implication from left to right.

We first show that every finite convergent corresponds to a rational number `q` and then use the
finite correctness proof (`of_correctness_of_terminates`) of `generalized_continued_fraction.of` to
show that `v = ↑q`.
-/

variables (v : K) (n : ℕ)

lemma exists_gcf_pair_rat_eq_of_nth_conts_aux :
  ∃ (conts : gcf.pair ℚ), (gcf.of v).continuants_aux n = (conts.map coe : gcf.pair K) :=
nat.strong_induction_on n
begin
  clear n,
  let g := gcf.of v,
  assume n IH,
  rcases n with _|_|n,
  -- n = 0
  { suffices : ∃ (gp : gcf.pair ℚ), gcf.pair.mk (1 : K) 0 = gp.map coe, by simpa [continuants_aux],
    use (gcf.pair.mk 1 0),
    simp },
  -- n = 1
  { suffices : ∃ (conts : gcf.pair ℚ), gcf.pair.mk g.h 1 = conts.map coe, by
      simpa [continuants_aux],
    use (gcf.pair.mk ⌊v⌋ 1),
    simp },
  -- 2 ≤ n
  { cases (IH (n + 1) $ lt_add_one (n + 1)) with pred_conts pred_conts_eq, -- invoke the IH
    cases s_ppred_nth_eq : (g.s.nth n) with gp_n,
    -- option.none
    { use pred_conts,
      have : g.continuants_aux (n + 2) = g.continuants_aux (n + 1), from
        continuants_aux_stable_of_terminated (n + 1).le_succ s_ppred_nth_eq,
      simp only [this, pred_conts_eq] },
    -- option.some
    { -- invoke the IH a second time
      cases (IH n $ lt_of_le_of_lt (n.le_succ) $ lt_add_one $ n + 1)
        with ppred_conts ppred_conts_eq,
      obtain ⟨a_eq_one, z, b_eq_z⟩ : gp_n.a = 1 ∧ ∃ (z : ℤ), gp_n.b = (z : K), from
        of_part_num_eq_one_and_exists_int_part_denom_eq s_ppred_nth_eq,
      -- finally, unfold the recurrence to obtain the required rational value.
      simp only [a_eq_one, b_eq_z,
        (continuants_aux_recurrence s_ppred_nth_eq ppred_conts_eq pred_conts_eq)],
      use (next_continuants 1 (z : ℚ) ppred_conts pred_conts),
      cases ppred_conts, cases pred_conts,
      simp [next_continuants, next_numerator, next_denominator] } }
end

lemma exists_gcf_pair_rat_eq_nth_conts :
  ∃ (conts : gcf.pair ℚ), (gcf.of v).continuants n = (conts.map coe : gcf.pair K) :=
by { rw [nth_cont_eq_succ_nth_cont_aux], exact (exists_gcf_pair_rat_eq_of_nth_conts_aux v $ n + 1) }

lemma exists_rat_eq_nth_numerator : ∃ (q : ℚ), (gcf.of v).numerators n = (q : K) :=
begin
  rcases (exists_gcf_pair_rat_eq_nth_conts v n) with ⟨⟨a, _⟩, nth_cont_eq⟩,
  use a,
  simp [num_eq_conts_a, nth_cont_eq],
end

lemma exists_rat_eq_nth_denominator : ∃ (q : ℚ), (gcf.of v).denominators n = (q : K) :=
begin
  rcases (exists_gcf_pair_rat_eq_nth_conts v n) with ⟨⟨_, b⟩, nth_cont_eq⟩,
  use b,
  simp [denom_eq_conts_b, nth_cont_eq]
end

/-- Every finite convergent corresponds to a rational number. -/
lemma exists_rat_eq_nth_convergent : ∃ (q : ℚ), (gcf.of v).convergents n = (q : K) :=
begin
  rcases (exists_rat_eq_nth_numerator v n) with ⟨Aₙ, nth_num_eq⟩,
  rcases (exists_rat_eq_nth_denominator v n) with ⟨Bₙ, nth_denom_eq⟩,
  use (Aₙ / Bₙ),
  simp [nth_num_eq, nth_denom_eq, convergent_eq_num_div_denom]
end

variable {v}

/-- Every terminating continued fraction corresponds to a rational number. -/
theorem exists_rat_eq_of_terminates (terminates : (gcf.of v).terminates) : ∃ (q : ℚ), v = ↑q :=
begin
  obtain ⟨n, v_eq_conv⟩ : ∃ n, v = (gcf.of v).convergents n, from
    of_correctness_of_terminates terminates,
  obtain ⟨q, conv_eq_q⟩ : ∃ (q : ℚ), (gcf.of v).convergents n = (↑q : K), from
    exists_rat_eq_nth_convergent v n,
  have : v = (↑q : K), from eq.trans v_eq_conv conv_eq_q,
  use [q, this]
end

end rat_of_terminates

section rat_translation
/-!
### Technical Translation Lemmas

Before we can show that the continued fraction of a rational number terminates, we have to prove
some technical translation lemmas. More precisely, in this section, we show that, given a rational
number `q : ℚ` and value `v : K` with `v = ↑q`, the continued fraction of `q` and `v` coincide.
In particular, we show that
```lean
    (↑(generalized_continued_fraction.of q : generalized_continued_fraction ℚ)
      : generalized_continued_fraction K)
  = generalized_continued_fraction.of v`
```
in `generalized_continued_fraction.coe_of_rat`.

To do this, we proceed bottom-up, showing the correspondence between the basic functions involved in
the computation first and then lift the results step-by-step.
-/

/- The lifting works for arbitrary linear ordered fields with a floor function. -/
variables {v : K} {q : ℚ} (v_eq_q : v = (↑q : K)) (n : ℕ)
include v_eq_q

/-! First, we show the correspondence for the very basic functions in
`generalized_continued_fraction.int_fract_pair`. -/
namespace int_fract_pair

lemma coe_of_rat_eq :
  ((int_fract_pair.of q).mapFr coe : int_fract_pair K) = int_fract_pair.of v :=
by simp [int_fract_pair.of, v_eq_q, fract]

lemma coe_stream_nth_rat_eq :
    ((int_fract_pair.stream q n).map (mapFr coe) : option $ int_fract_pair K)
  = int_fract_pair.stream v n :=
begin
  induction n with n IH,
  case nat.zero : { simp [int_fract_pair.stream, (coe_of_rat_eq v_eq_q)] },
  case nat.succ :
  { rw v_eq_q at IH,
    cases stream_q_nth_eq : (int_fract_pair.stream q n) with ifp_n,
    case option.none : { simp [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq] },
    case option.some :
    { cases ifp_n with b fr,
      cases decidable.em (fr = 0) with fr_zero fr_ne_zero,
      { simp [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq, fr_zero] },
      { replace IH : some (int_fract_pair.mk b ↑fr) = int_fract_pair.stream ↑q n, by
          rwa [stream_q_nth_eq] at IH,
        have : (fr : K)⁻¹ = ((fr⁻¹ : ℚ) : K), by norm_cast,
        have coe_of_fr := (coe_of_rat_eq this),
        simp [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq, fr_ne_zero],
        unfold_coes,
        simpa [coe_of_fr] } } }
end

lemma coe_stream_rat_eq :
  ((int_fract_pair.stream q).map (option.map (mapFr coe)) : stream $ option $ int_fract_pair K) =
    int_fract_pair.stream v :=
by { funext n, exact (int_fract_pair.coe_stream_nth_rat_eq v_eq_q n) }

end int_fract_pair

/-! Now we lift the coercion results to the continued fraction computation. -/

lemma coe_of_h_rat_eq : (↑((gcf.of q).h : ℚ) : K) = (gcf.of v).h :=
begin
  unfold gcf.of int_fract_pair.seq1,
  rw ←(int_fract_pair.coe_of_rat_eq v_eq_q),
  simp
end

lemma coe_of_s_nth_rat_eq :
  (((gcf.of q).s.nth n).map (gcf.pair.map coe) : option $ gcf.pair K) = (gcf.of v).s.nth n :=
begin
  simp only [gcf.of, gcf.int_fract_pair.seq1, seq.map_nth, seq.nth_tail],
  simp only [seq.nth],
  rw [←(int_fract_pair.coe_stream_rat_eq v_eq_q)],
  rcases succ_nth_stream_eq : (int_fract_pair.stream q (n + 1)) with _ | ⟨_, _⟩;
  simp [stream.map, stream.nth, succ_nth_stream_eq]
end

lemma coe_of_s_rat_eq :
  (((gcf.of q).s).map (gcf.pair.map coe) : seq $ gcf.pair K) = (gcf.of v).s :=
by { ext n, rw ←(coe_of_s_nth_rat_eq v_eq_q), refl }

/-- Given `(v : K), (q : ℚ), and v = q`, we have that `gcf.of q = gcf.of v` -/
lemma coe_of_rat_eq : (⟨(gcf.of q).h, (gcf.of q).s.map (gcf.pair.map coe)⟩ : gcf K) = gcf.of v :=
begin
  cases gcf_v_eq : (gcf.of v) with h s,
  have : ↑⌊↑q⌋ = h, by { rw v_eq_q at gcf_v_eq, injection gcf_v_eq },
  simp [(coe_of_h_rat_eq v_eq_q), (coe_of_s_rat_eq v_eq_q), gcf_v_eq],
  rwa [←(@rat.cast_floor K _ _ q), floor_ring_unique]
end

lemma of_terminates_iff_of_rat_terminates {v : K} {q : ℚ} (v_eq_q : v = (q : K)) :
  (gcf.of v).terminates ↔ (gcf.of q).terminates :=
begin
  split;
  intro h;
  cases h with n h;
  use n;
  simp only [seq.terminated_at, (coe_of_s_nth_rat_eq v_eq_q n).symm] at h ⊢;
  cases ((gcf.of q).s.nth n);
  trivial
end

end rat_translation

section terminates_of_rat
/-!
### Continued Fractions of Rationals Terminate

Finally, we show that the continued fraction of a rational number terminates.

The crucial insight is that, given any `q : ℚ` with `0 < q < 1`, the numerator of `fract q` is
smaller than the numerator of `q`. As the continued fraction computation recursively operates on
the fractional part of a value `v` and `0 ≤ fract v < 1`, we infer that the numerator of the
fractional part in the computation decreases by at least one in each step. As `0 ≤ fract v`,
this process must stop after finite number of steps, and the computation hence terminates.
-/

namespace int_fract_pair
variables {q : ℚ} {n : ℕ}

/--
Shows that for any `q : ℚ` with `0 < q < 1`, the numerator of the fractional part of
`int_fract_pair.of q⁻¹` is smaller than the numerator of `q`.
-/

/-- Shows that the sequence of numerators of the fractional parts of the stream is strictly
monotonically decreasing. -/
lemma stream_succ_nth_fr_num_lt_nth_fr_num_rat {ifp_n ifp_succ_n : int_fract_pair ℚ}
  (stream_nth_eq : int_fract_pair.stream q n = some ifp_n)
  (stream_succ_nth_eq : int_fract_pair.stream q (n + 1) = some ifp_succ_n) :
  ifp_succ_n.fr.num < ifp_n.fr.num :=
begin
  obtain ⟨ifp_n', stream_nth_eq', ifp_n_fract_ne_zero, int_fract_pair.of_eq_ifp_succ_n⟩ :
    ∃ ifp_n', int_fract_pair.stream q 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 stream_succ_nth_eq,
  have : ifp_n = ifp_n', by injection (eq.trans stream_nth_eq.symm stream_nth_eq'),
  cases this,
  rw [←int_fract_pair.of_eq_ifp_succ_n],
  cases (nth_stream_fr_nonneg_lt_one stream_nth_eq) with zero_le_ifp_n_fract ifp_n_fract_lt_one,
  have : 0 < ifp_n.fr, from (lt_of_le_of_ne zero_le_ifp_n_fract $ ifp_n_fract_ne_zero.symm),
  exact (of_inv_fr_num_lt_num_of_pos this)
end

lemma stream_nth_fr_num_le_fr_num_sub_n_rat : ∀ {ifp_n : int_fract_pair ℚ},
  int_fract_pair.stream q n = some ifp_n → ifp_n.fr.num ≤ (int_fract_pair.of q).fr.num - n :=
begin
  induction n with n IH,
  case nat.zero
  { assume ifp_zero stream_zero_eq,
    have : int_fract_pair.of q = ifp_zero, by injection stream_zero_eq,
    simp [le_refl, this.symm] },
  case nat.succ
  { assume ifp_succ_n stream_succ_nth_eq,
    suffices : ifp_succ_n.fr.num + 1 ≤ (int_fract_pair.of q).fr.num - n, by
    { rw [int.coe_nat_succ, sub_add_eq_sub_sub],
      solve_by_elim [le_sub_right_of_add_le] },
    rcases (succ_nth_stream_eq_some_iff.elim_left stream_succ_nth_eq) with
      ⟨ifp_n, stream_nth_eq, -⟩,
    have : ifp_succ_n.fr.num < ifp_n.fr.num, from
      stream_succ_nth_fr_num_lt_nth_fr_num_rat stream_nth_eq stream_succ_nth_eq,
    have : ifp_succ_n.fr.num + 1 ≤ ifp_n.fr.num, from int.add_one_le_of_lt this,
    exact (le_trans this (IH stream_nth_eq)) }
end

lemma exists_nth_stream_eq_none_of_rat (q : ℚ) : ∃ (n : ℕ), int_fract_pair.stream q n = none :=
begin
  let fract_q_num := (fract q).num, let n := fract_q_num.nat_abs + 1,
  cases stream_nth_eq : (int_fract_pair.stream q n) with ifp,
  { use n, exact stream_nth_eq },
  { -- arrive at a contradiction since the numerator decreased num + 1 times but every fractional
    -- value is nonnegative.
    have ifp_fr_num_le_q_fr_num_sub_n : ifp.fr.num ≤ fract_q_num - n, from
      stream_nth_fr_num_le_fr_num_sub_n_rat stream_nth_eq,
    have : fract_q_num - n = -1, by
    { have : 0 ≤ fract_q_num, from rat.num_nonneg_iff_zero_le.elim_right (fract_nonneg q),
      simp [(int.nat_abs_of_nonneg this), sub_add_eq_sub_sub_swap, sub_right_comm] },
    have : ifp.fr.num ≤ -1, by rwa this at ifp_fr_num_le_q_fr_num_sub_n,
    have : 0 ≤ ifp.fr, from (nth_stream_fr_nonneg_lt_one stream_nth_eq).left,
    have : 0 ≤ ifp.fr.num, from rat.num_nonneg_iff_zero_le.elim_right this,
    linarith }
end

end int_fract_pair

/-- The continued fraction of a rational number terminates. -/
theorem terminates_of_rat (q : ℚ) : (gcf.of q).terminates :=
exists.elim (int_fract_pair.exists_nth_stream_eq_none_of_rat q)
( assume n stream_nth_eq_none,
  exists.intro n
  ( have int_fract_pair.stream q (n + 1) = none, from
      int_fract_pair.stream_is_seq q stream_nth_eq_none,
    (of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none.elim_right this) ) )

end terminates_of_rat

/--
The continued fraction `generalized_continued_fraction.of v` terminates if and only if `v ∈ ℚ`.
-/
theorem terminates_iff_rat (v : K) :
  (gcf.of v).terminates ↔ ∃ (q : ℚ), v = (q : K) :=
iff.intro
( assume terminates_v : (gcf.of v).terminates,
  show ∃ (q : ℚ), v = (q : K), from exists_rat_eq_of_terminates terminates_v )
( assume exists_q_eq_v : ∃ (q : ℚ), v = (↑q : K),
  exists.elim exists_q_eq_v
  ( assume q,
    assume v_eq_q : v = ↑q,
    have (gcf.of q).terminates, from terminates_of_rat q,
    (of_terminates_iff_of_rat_terminates v_eq_q).elim_right this ) )

end generalized_continued_fraction