/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.associated
import Mathlib.data.fintype.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Some facts about finite rings
-/

theorem card_units_lt (R : Type u_1) [semiring R] [nontrivial R] [fintype R] :
    fintype.card (units R) < fintype.card R :=
  card_lt_card_of_injective_of_not_mem coe units.ext not_is_unit_zero

end Mathlib


-- Representation theory of finite groups. In particular, Maschke's theorem
-- and character theory

import representation
import homological_algebra
import data.set.finite

open group_representation -- Potentially dangerous to open a namespace, however I will exclusively do
-- group theory here, because Maschke's theorem fails for monoids.
open direct_sum

variables (G K V : Type)
variables [group G] [discrete_field K] [add_comm_group V] [vector_space K V] [group_representation G K V]

-- These three lines give a proof that G is a finite group
def group_as_set : set G := {g | g = g}
lemma mem_group : ∀ (g:G), g ∈ group_as_set G := λ g, show g = g, from eq.refl g
variable G_is_finite : finset (group_as_set G)

/-- Maschke's theorem implies that an indecomposable representation is in fact irreducible.
    In fact, the precise statement is that if we have a subrepresentation of M, then M
    decomposes. -/
theorem subrepresentation_has_complement (U : subspace K V) : is_subrepresentation G U →
    ∃ (W : submodule K V) [is_subrepresentation G W], V = (U × W) :=
begin
intro sub_rep,

sorry,
end

------ playground
variables (U : submodule K V) [is_subrepresentation G U]
#check subrepresentation_has_complement G K V U _


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import geometry.manifold.smooth_manifold_with_corners
import topology.paracompact
import topology.metric_space.metrizable

/-!
# Metrizability of a σ-compact manifold

In this file we show that a σ-compact Hausdorff topological manifold over a finite dimensional real
vector space is metrizable.
-/

open topological_space

/-- A σ-compact Hausdorff topological manifold over a finite dimensional real vector space is
metrizable. -/
lemma manifold_with_corners.metrizable_space
  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
  {H : Type*} [topological_space H] (I : model_with_corners ℝ E H)
  (M : Type*) [topological_space M] [charted_space H M]
  [sigma_compact_space M] [t2_space M] : metrizable_space M :=
begin
  haveI := I.locally_compact, haveI := charted_space.locally_compact H M,
  haveI : normal_space M := normal_of_paracompact_t2,
  haveI := I.second_countable_topology,
  haveI := charted_space.second_countable_of_sigma_compact H M,
  exact metrizable_space_of_t3_second_countable M
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author:  Aaron Anderson.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.bounded_lattice
import Mathlib.data.set.intervals.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Intervals in Lattices

In this file, we provide instances of lattice structures on intervals within lattices.
Some of them depend on the order of the endpoints of the interval, and thus are not made
global instances. These are probably not all of the lattice instances that could be placed on these
intervals, but more can be added easily along the same lines when needed.

## Main definitions
In the following, `*` can represent either `c`, `o`, or `i`.
  * `set.Ic*.semilattice_inf_bot`
  * `set.Ii*.semillatice_inf`
  * `set.I*c.semilattice_sup_top`
  * `set.I*c.semillatice_inf`
  * `set.Iic.bounded_lattice`, within a `bounded_lattice`
  * `set.Ici.bounded_lattice`, within a `bounded_lattice`

-/

namespace set

namespace Ico

protected instance semilattice_inf {α : Type u_1} {a : α} {b : α} [semilattice_inf α] :
    semilattice_inf ↥(Ico a b) :=
  subtype.semilattice_inf sorry

/-- `Ico a b` has a bottom element whenever `a < b`. -/
def order_bot {α : Type u_1} {a : α} {b : α} [partial_order α] (h : a < b) : order_bot ↥(Ico a b) :=
  order_bot.mk { val := a, property := sorry } partial_order.le partial_order.lt sorry sorry sorry
    sorry

/-- `Ico a b` is a `semilattice_inf_bot` whenever `a < b`. -/
def semilattice_inf_bot {α : Type u_1} {a : α} {b : α} [semilattice_inf α] (h : a < b) :
    semilattice_inf_bot ↥(Ico a b) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

end Ico

namespace Iio

protected instance semilattice_inf {α : Type u_1} [semilattice_inf α] {a : α} :
    semilattice_inf ↥(Iio a) :=
  subtype.semilattice_inf sorry

end Iio

namespace Ioc

protected instance semilattice_sup {α : Type u_1} {a : α} {b : α} [semilattice_sup α] :
    semilattice_sup ↥(Ioc a b) :=
  subtype.semilattice_sup sorry

/-- `Ioc a b` has a top element whenever `a < b`. -/
def order_top {α : Type u_1} {a : α} {b : α} [partial_order α] (h : a < b) : order_top ↥(Ioc a b) :=
  order_top.mk { val := b, property := sorry } partial_order.le partial_order.lt sorry sorry sorry
    sorry

/-- `Ioc a b` is a `semilattice_sup_top` whenever `a < b`. -/
def semilattice_sup_top {α : Type u_1} {a : α} {b : α} [semilattice_sup α] (h : a < b) :
    semilattice_sup_top ↥(Ioc a b) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

end Ioc

namespace Iio

protected instance set.Ioi.semilattice_sup {α : Type u_1} [semilattice_sup α] {a : α} :
    semilattice_sup ↥(Ioi a) :=
  subtype.semilattice_sup sorry

end Iio

namespace Iic

protected instance semilattice_inf {α : Type u_1} {a : α} [semilattice_inf α] :
    semilattice_inf ↥(Iic a) :=
  subtype.semilattice_inf sorry

protected instance semilattice_sup {α : Type u_1} {a : α} [semilattice_sup α] :
    semilattice_sup ↥(Iic a) :=
  subtype.semilattice_sup sorry

protected instance lattice {α : Type u_1} {a : α} [lattice α] : lattice ↥(Iic a) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

protected instance order_top {α : Type u_1} {a : α} [partial_order α] : order_top ↥(Iic a) :=
  order_top.mk { val := a, property := sorry } partial_order.le partial_order.lt sorry sorry sorry
    sorry

@[simp] theorem coe_top {α : Type u_1} [partial_order α] {a : α} : ↑⊤ = a := rfl

protected instance semilattice_inf_top {α : Type u_1} {a : α} [semilattice_inf α] :
    semilattice_inf_top ↥(Iic a) :=
  semilattice_inf_top.mk order_top.top semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance semilattice_sup_top {α : Type u_1} {a : α} [semilattice_sup α] :
    semilattice_sup_top ↥(Iic a) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance order_bot {α : Type u_1} {a : α} [order_bot α] : order_bot ↥(Iic a) :=
  order_bot.mk { val := ⊥, property := bot_le } partial_order.le partial_order.lt sorry sorry sorry
    sorry

@[simp] theorem coe_bot {α : Type u_1} [order_bot α] {a : α} : ↑⊥ = ⊥ := rfl

protected instance semilattice_inf_bot {α : Type u_1} {a : α} [semilattice_inf_bot α] :
    semilattice_inf_bot ↥(Iic a) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance semilattice_sup_bot {α : Type u_1} {a : α} [semilattice_sup_bot α] :
    semilattice_sup_bot ↥(Iic a) :=
  semilattice_sup_bot.mk order_bot.bot semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance bounded_lattice {α : Type u_1} {a : α} [bounded_lattice α] :
    bounded_lattice ↥(Iic a) :=
  bounded_lattice.mk lattice.sup order_top.le order_top.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

end Iic

namespace Ici

protected instance semilattice_inf {α : Type u_1} {a : α} [semilattice_inf α] :
    semilattice_inf ↥(Ici a) :=
  subtype.semilattice_inf sorry

protected instance semilattice_sup {α : Type u_1} {a : α} [semilattice_sup α] :
    semilattice_sup ↥(Ici a) :=
  subtype.semilattice_sup sorry

protected instance lattice {α : Type u_1} {a : α} [lattice α] : lattice ↥(Ici a) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

protected instance order_bot {α : Type u_1} {a : α} [partial_order α] : order_bot ↥(Ici a) :=
  order_bot.mk { val := a, property := sorry } partial_order.le partial_order.lt sorry sorry sorry
    sorry

@[simp] theorem coe_bot {α : Type u_1} [partial_order α] {a : α} : ↑⊥ = a := rfl

protected instance semilattice_inf_bot {α : Type u_1} {a : α} [semilattice_inf α] :
    semilattice_inf_bot ↥(Ici a) :=
  semilattice_inf_bot.mk order_bot.bot semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance semilattice_sup_bot {α : Type u_1} {a : α} [semilattice_sup α] :
    semilattice_sup_bot ↥(Ici a) :=
  semilattice_sup_bot.mk order_bot.bot semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance order_top {α : Type u_1} {a : α} [order_top α] : order_top ↥(Ici a) :=
  order_top.mk { val := ⊤, property := le_top } partial_order.le partial_order.lt sorry sorry sorry
    sorry

@[simp] theorem coe_top {α : Type u_1} [order_top α] {a : α} : ↑⊤ = ⊤ := rfl

protected instance semilattice_sup_top {α : Type u_1} {a : α} [semilattice_sup_top α] :
    semilattice_sup_top ↥(Ici a) :=
  semilattice_sup_top.mk order_top.top semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

protected instance semilattice_inf_top {α : Type u_1} {a : α} [semilattice_inf_top α] :
    semilattice_inf_top ↥(Ici a) :=
  semilattice_inf_top.mk order_top.top semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance bounded_lattice {α : Type u_1} {a : α} [bounded_lattice α] :
    bounded_lattice ↥(Ici a) :=
  bounded_lattice.mk lattice.sup order_top.le order_top.lt sorry sorry sorry sorry sorry sorry
    lattice.inf sorry sorry sorry order_top.top sorry order_bot.bot sorry

end Ici

namespace Icc

protected instance semilattice_inf {α : Type u_1} [semilattice_inf α] {a : α} {b : α} :
    semilattice_inf ↥(Icc a b) :=
  subtype.semilattice_inf sorry

protected instance semilattice_sup {α : Type u_1} [semilattice_sup α] {a : α} {b : α} :
    semilattice_sup ↥(Icc a b) :=
  subtype.semilattice_sup sorry

protected instance lattice {α : Type u_1} [lattice α] {a : α} {b : α} : lattice ↥(Icc a b) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

/-- `Icc a b` has a bottom element whenever `a ≤ b`. -/
def order_bot {α : Type u_1} [partial_order α] {a : α} {b : α} (h : a ≤ b) : order_bot ↥(Icc a b) :=
  order_bot.mk { val := a, property := sorry } partial_order.le partial_order.lt sorry sorry sorry
    sorry

/-- `Icc a b` has a top element whenever `a ≤ b`. -/
def order_top {α : Type u_1} [partial_order α] {a : α} {b : α} (h : a ≤ b) : order_top ↥(Icc a b) :=
  order_top.mk { val := b, property := sorry } partial_order.le partial_order.lt sorry sorry sorry
    sorry

/-- `Icc a b` is a `semilattice_inf_bot` whenever `a ≤ b`. -/
def semilattice_inf_bot {α : Type u_1} [semilattice_inf α] {a : α} {b : α} (h : a ≤ b) :
    semilattice_inf_bot ↥(Icc a b) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

/-- `Icc a b` is a `semilattice_inf_top` whenever `a ≤ b`. -/
def semilattice_inf_top {α : Type u_1} [semilattice_inf α] {a : α} {b : α} (h : a ≤ b) :
    semilattice_inf_top ↥(Icc a b) :=
  semilattice_inf_top.mk order_top.top order_top.le order_top.lt sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

/-- `Icc a b` is a `semilattice_sup_bot` whenever `a ≤ b`. -/
def semilattice_sup_bot {α : Type u_1} [semilattice_sup α] {a : α} {b : α} (h : a ≤ b) :
    semilattice_sup_bot ↥(Icc a b) :=
  semilattice_sup_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

/-- `Icc a b` is a `semilattice_sup_top` whenever `a ≤ b`. -/
def semilattice_sup_top {α : Type u_1} [semilattice_sup α] {a : α} {b : α} (h : a ≤ b) :
    semilattice_sup_top ↥(Icc a b) :=
  semilattice_sup_top.mk order_top.top order_top.le order_top.lt sorry sorry sorry sorry
    semilattice_sup.sup sorry sorry sorry

/-- `Icc a b` is a `bounded_lattice` whenever `a ≤ b`. -/
def bounded_lattice {α : Type u_1} [lattice α] {a : α} {b : α} (h : a ≤ b) :
    bounded_lattice ↥(Icc a b) :=
  bounded_lattice.mk semilattice_sup_top.sup semilattice_inf_bot.le semilattice_inf_bot.lt sorry
    sorry sorry sorry sorry sorry semilattice_inf_bot.inf sorry sorry sorry semilattice_sup_top.top
    sorry semilattice_inf_bot.bot sorry

end Mathlib


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.rel
! leanprover-community/mathlib commit 706d88f2b8fdfeb0b22796433d7a6c1a010af9f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.CompleteLattice
import Mathlib.Order.GaloisConnection

/-!
# Relations

This file defines bundled relations. A relation between `α` and `β` is a function `α → β → Prop`.
Relations are also known as set-valued functions, or partial multifunctions.

## Main declarations

* `Rel α β`: Relation between `α` and `β`.
* `Rel.inv`: `r.inv` is the `rel β α` obtained by swapping the arguments of `r`.
* `Rel.dom`: Domain of a relation. `x ∈ r.dom` iff there exists `y` such that `r x y`.
* `Rel.codom`: Codomain, aka range, of a relation. `y ∈ r.codom` iff there exists `x` such that
  `r x y`.
* `Rel.comp`: Relation composition. Note that the arguments order follows the `CategoryTheory/`
  one, so `r.comp s x z ↔ ∃ y, r x y ∧ s y z`.
* `Rel.image`: Image of a set under a relation. `r.image s` is the set of `f x` over all `x ∈ s`.
* `Rel.preimage`: Preimage of a set under a relation. Note that `r.preimage = r.inv.image`.
* `Rel.core`: Core of a set. For `s : Set β`, `r.core s` is the set of `x : α` such that all `y`
  related to `x` are in `s`.
* `Rel.restrict_domain`: Domain-restriction of a relation to a subtype.
* `Function.graph`: Graph of a function as a relation.
-/

variable {α β γ : Type _}

/-- A relation on `α` and `β`, aka a set-valued function, aka a partial multifunction -/
def Rel (α β : Type _) :=
  α → β → Prop -- deriving CompleteLattice, Inhabited
#align rel Rel

-- Porting note: `deriving` above doesn't work.
instance : CompleteLattice (Rel α β) := show CompleteLattice (α → β → Prop) from inferInstance
instance : Inhabited (Rel α β) := show Inhabited (α → β → Prop) from inferInstance

namespace Rel

variable (r : Rel α β)

-- Porting note: required for later theorems.
@[ext] theorem ext {r s : Rel α β} : (∀ a, r a = s a) → r = s := funext

/-- The inverse relation : `r.inv x y ↔ r y x`. Note that this is *not* a groupoid inverse. -/
def inv : Rel β α :=
  flip r
#align rel.inv Rel.inv

theorem inv_def (x : α) (y : β) : r.inv y x ↔ r x y :=
  Iff.rfl
#align rel.inv_def Rel.inv_def

theorem inv_inv : inv (inv r) = r := by
  ext (x y)
  rfl
#align rel.inv_inv Rel.inv_inv

/-- Domain of a relation -/
def dom := { x | ∃ y, r x y }
#align rel.dom Rel.dom

theorem dom_mono {r s : Rel α β} (h : r ≤ s) : dom r ⊆ dom s := fun a ⟨b, hx⟩ => ⟨b, h a b hx⟩
#align rel.dom_mono Rel.dom_mono

/-- Codomain aka range of a relation -/
def codom := { y | ∃ x, r x y }
#align rel.codom Rel.codom

theorem codom_inv : r.inv.codom = r.dom := by
  ext (x y)
  rfl
#align rel.codom_inv Rel.codom_inv

theorem dom_inv : r.inv.dom = r.codom := by
  ext (x y)
  rfl
#align rel.dom_inv Rel.dom_inv

/-- Composition of relation; note that it follows the `CategoryTheory/` order of arguments. -/
def comp (r : Rel α β) (s : Rel β γ) : Rel α γ := fun x z => ∃ y, r x y ∧ s y z
#align rel.comp Rel.comp

-- Porting note: the original `∘` syntax can't be overloaded here, lean considers it ambiguous.
-- TODO: Change this syntax to something nicer?
/-- Local syntax for composition of relations. -/
local infixr:90 " • " => Rel.comp

theorem comp_assoc (r : Rel α β) (s : Rel β γ) (t : Rel γ δ) : (r • s) • t = r • (s • t) := by
  unfold comp; ext (x w); constructor
  · rintro ⟨z, ⟨y, rxy, syz⟩, tzw⟩; exact ⟨y, rxy, z, syz, tzw⟩
  · rintro ⟨y, rxy, z, syz, tzw⟩; exact ⟨z, ⟨y, rxy, syz⟩, tzw⟩
#align rel.comp_assoc Rel.comp_assoc

@[simp]
theorem comp_right_id (r : Rel α β) : r • @Eq β = r := by
  unfold comp
  ext y
  simp
#align rel.comp_right_id Rel.comp_right_id

@[simp]
theorem comp_left_id (r : Rel α β) : @Eq α • r = r := by
  unfold comp
  ext x
  simp
#align rel.comp_left_id Rel.comp_left_id

theorem inv_id : inv (@Eq α) = @Eq α := by
  ext (x y)
  constructor <;> apply Eq.symm
#align rel.inv_id Rel.inv_id

theorem inv_comp (r : Rel α β) (s : Rel β γ) : inv (r • s) = inv s • inv r := by
  ext (x z)
  simp [comp, inv, flip, and_comm]
#align rel.inv_comp Rel.inv_comp

/-- Image of a set under a relation -/
def image (s : Set α) : Set β := { y | ∃ x ∈ s, r x y }
#align rel.image Rel.image

theorem mem_image (y : β) (s : Set α) : y ∈ image r s ↔ ∃ x ∈ s, r x y :=
  Iff.rfl
#align rel.mem_image Rel.mem_image

theorem image_subset : ((· ⊆ ·) ⇒ (· ⊆ ·)) r.image r.image := fun _ _ h _ ⟨x, xs, rxy⟩ =>
  ⟨x, h xs, rxy⟩
#align rel.image_subset Rel.image_subset

theorem image_mono : Monotone r.image :=
  r.image_subset
#align rel.image_mono Rel.image_mono

theorem image_inter (s t : Set α) : r.image (s ∩ t) ⊆ r.image s ∩ r.image t :=
  r.image_mono.map_inf_le s t
#align rel.image_inter Rel.image_inter

theorem image_union (s t : Set α) : r.image (s ∪ t) = r.image s ∪ r.image t :=
  le_antisymm
    (fun _y ⟨x, xst, rxy⟩ =>
      xst.elim (fun xs => Or.inl ⟨x, ⟨xs, rxy⟩⟩) fun xt => Or.inr ⟨x, ⟨xt, rxy⟩⟩)
    (r.image_mono.le_map_sup s t)
#align rel.image_union Rel.image_union

@[simp]
theorem image_id (s : Set α) : image (@Eq α) s = s := by
  ext x
  simp [mem_image]
#align rel.image_id Rel.image_id

theorem image_comp (s : Rel β γ) (t : Set α) : image (r • s) t = image s (image r t) := by
  ext z; simp only [mem_image]; constructor
  · rintro ⟨x, xt, y, rxy, syz⟩; exact ⟨y, ⟨x, xt, rxy⟩, syz⟩
  · rintro ⟨y, ⟨x, xt, rxy⟩, syz⟩; exact ⟨x, xt, y, rxy, syz⟩
#align rel.image_comp Rel.image_comp

theorem image_univ : r.image Set.univ = r.codom := by
  ext y
  simp [mem_image, codom]
#align rel.image_univ Rel.image_univ

/-- Preimage of a set under a relation `r`. Same as the image of `s` under `r.inv` -/
def preimage (s : Set β) : Set α :=
  r.inv.image s
#align rel.preimage Rel.preimage

theorem mem_preimage (x : α) (s : Set β) : x ∈ r.preimage s ↔ ∃ y ∈ s, r x y :=
  Iff.rfl
#align rel.mem_preimage Rel.mem_preimage

theorem preimage_def (s : Set β) : preimage r s = { x | ∃ y ∈ s, r x y } :=
  Set.ext fun _ => mem_preimage _ _ _
#align rel.preimage_def Rel.preimage_def

theorem preimage_mono {s t : Set β} (h : s ⊆ t) : r.preimage s ⊆ r.preimage t :=
  image_mono _ h
#align rel.preimage_mono Rel.preimage_mono

theorem preimage_inter (s t : Set β) : r.preimage (s ∩ t) ⊆ r.preimage s ∩ r.preimage t :=
  image_inter _ s t
#align rel.preimage_inter Rel.preimage_inter

theorem preimage_union (s t : Set β) : r.preimage (s ∪ t) = r.preimage s ∪ r.preimage t :=
  image_union _ s t
#align rel.preimage_union Rel.preimage_union

theorem preimage_id (s : Set α) : preimage (@Eq α) s = s := by
  simp only [preimage, inv_id, image_id]
#align rel.preimage_id Rel.preimage_id

theorem preimage_comp (s : Rel β γ) (t : Set γ) : preimage (r • s) t = preimage r (preimage s t) :=
  by simp only [preimage, inv_comp, image_comp]
#align rel.preimage_comp Rel.preimage_comp

theorem preimage_univ : r.preimage Set.univ = r.dom := by rw [preimage, image_univ, codom_inv]
#align rel.preimage_univ Rel.preimage_univ

/-- Core of a set `s : Set β` w.r.t `r : Rel α β` is the set of `x : α` that are related *only*
to elements of `s`. Other generalization of `Function.preimage`. -/
def core (s : Set β) := { x | ∀ y, r x y → y ∈ s }
#align rel.core Rel.core

theorem core_subset : ((· ⊆ ·) ⇒ (· ⊆ ·)) r.core r.core := fun _s _t h _x h' y rxy => h (h' y rxy)
#align rel.core_subset Rel.core_subset

theorem core_mono : Monotone r.core :=
  r.core_subset
#align rel.core_mono Rel.core_mono

theorem core_inter (s t : Set β) : r.core (s ∩ t) = r.core s ∩ r.core t :=
  Set.ext (by simp [mem_core, imp_and, forall_and])
#align rel.core_inter Rel.core_inter

theorem core_union (s t : Set β) : r.core s ∪ r.core t ⊆ r.core (s ∪ t) :=
  r.core_mono.le_map_sup s t
#align rel.core_union Rel.core_union

@[simp]
theorem core_univ : r.core Set.univ = Set.univ :=
  Set.ext (by simp [mem_core])
#align rel.core_univ Rel.core_univ

theorem core_id (s : Set α) : core (@Eq α) s = s := by simp [core]
#align rel.core_id Rel.core_id

theorem core_comp (s : Rel β γ) (t : Set γ) : core (r • s) t = core r (core s t) := by
  ext x; simp [core, comp]; constructor
  · exact fun h y rxy z => h z y rxy
  · exact fun h z y rzy => h y rzy z
#align rel.core_comp Rel.core_comp

/-- Restrict the domain of a relation to a subtype. -/
def restrictDomain (s : Set α) : Rel { x // x ∈ s } β := fun x y => r x.val y
#align rel.restrict_domain Rel.restrictDomain

theorem image_subset_iff (s : Set α) (t : Set β) : image r s ⊆ t ↔ s ⊆ core r t :=
  Iff.intro (fun h x xs _y rxy => h ⟨x, xs, rxy⟩) fun h y ⟨_x, xs, rxy⟩ => h xs y rxy
#align rel.image_subset_iff Rel.image_subset_iff

theorem image_core_gc : GaloisConnection r.image r.core :=
  image_subset_iff _
#align rel.image_core_gc Rel.image_core_gc

end Rel

namespace Function

/-- The graph of a function as a relation. -/
def graph (f : α → β) : Rel α β := fun x y => f x = y
#align function.graph Function.graph

end Function

namespace Set

-- TODO: if image were defined with bounded quantification in corelib, the next two would
-- be definitional
theorem image_eq (f : α → β) (s : Set α) : f '' s = (Function.graph f).image s := by
  simp [Set.image, Function.graph, Rel.image]
#align set.image_eq Set.image_eq

theorem preimage_eq (f : α → β) (s : Set β) : f ⁻¹' s = (Function.graph f).preimage s := by
  simp [Set.preimage, Function.graph, Rel.preimage, Rel.inv, flip, Rel.image]
#align set.preimage_eq Set.preimage_eq

theorem preimage_eq_core (f : α → β) (s : Set β) : f ⁻¹' s = (Function.graph f).core s := by
  simp [Set.preimage, Function.graph, Rel.core]
#align set.preimage_eq_core Set.preimage_eq_core

end Set


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

! This file was ported from Lean 3 source module order.succ_pred.linear_locally_finite
! leanprover-community/mathlib commit 2705404e701abc6b3127da906f40bae062a169c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.LocallyFinite
import Mathlib.Order.SuccPred.Basic
import Mathlib.Order.Hom.Basic
import Mathlib.Data.Countable.Basic
import Mathlib.Logic.Encodable.Basic

/-!
# Linear locally finite orders

We prove that a `LinearOrder` which is a `LocallyFiniteOrder` also verifies
* `SuccOrder`
* `PredOrder`
* `IsSuccArchimedean`
* `IsPredArchimedean`
* `Countable`

Furthermore, we show that there is an `OrderIso` between such an order and a subset of `ℤ`.

## Main definitions

* `toZ i0 i`: in a linear order on which we can define predecessors and successors and which is
  succ-archimedean, we can assign a unique integer `toZ i0 i` to each element `i : ι` while
  respecting the order, starting from `toZ i0 i0 = 0`.

## Main results

Instances about linear locally finite orders:
* `LinearLocallyFiniteOrder.SuccOrder`: a linear locally finite order has a successor function.
* `LinearLocallyFiniteOrder.PredOrder`: a linear locally finite order has a predecessor
  function.
* `LinearLocallyFiniteOrder.isSuccArchimedean`: a linear locally finite order is
  succ-archimedean.
* `LinearOrder.pred_archimedean_of_succ_archimedean`: a succ-archimedean linear order is also
  pred-archimedean.
* `countable_of_linear_succ_pred_arch` : a succ-archimedean linear order is countable.

About `toZ`:
* `orderIsoRangeToZOfLinearSuccPredArch`: `toZ` defines an `OrderIso` between `ι` and its
  range.
* `orderIsoNatOfLinearSuccPredArch`: if the order has a bot but no top, `toZ` defines an
  `OrderIso` between `ι` and `ℕ`.
* `orderIsoIntOfLinearSuccPredArch`: if the order has neither bot nor top, `toZ` defines an
  `OrderIso` between `ι` and `ℤ`.
* `orderIsoRangeOfLinearSuccPredArch`: if the order has both a bot and a top, `toZ` gives an
  `OrderIso` between `ι` and `Finset.range ((toZ ⊥ ⊤).toNat + 1)`.

-/

open Order

variable {ι : Type _} [LinearOrder ι]

namespace LinearLocallyFiniteOrder

/-- Successor in a linear order. This defines a true successor only when `i` is isolated from above,
i.e. when `i` is not the greatest lower bound of `(i, ∞)`. -/
noncomputable def succFn (i : ι) : ι :=
  (exists_glb_Ioi i).choose
#align linear_locally_finite_order.succ_fn LinearLocallyFiniteOrder.succFn

theorem succFn_spec (i : ι) : IsGLB (Set.Ioi i) (succFn i) :=
  (exists_glb_Ioi i).choose_spec
#align linear_locally_finite_order.succ_fn_spec LinearLocallyFiniteOrder.succFn_spec

theorem le_succFn (i : ι) : i ≤ succFn i := by
  rw [le_isGLB_iff (succFn_spec i), mem_lowerBounds]
  exact fun x hx ↦ le_of_lt hx
#align linear_locally_finite_order.le_succ_fn LinearLocallyFiniteOrder.le_succFn

theorem isMax_of_succFn_le [LocallyFiniteOrder ι] (i : ι) (hi : succFn i ≤ i) : IsMax i := by
  refine' fun j _ ↦ not_lt.mp fun hij_lt ↦ _
  have h_succFn_eq : succFn i = i := le_antisymm hi (le_succFn i)
  have h_glb : IsGLB (Finset.Ioc i j : Set ι) i := by
    rw [Finset.coe_Ioc]
    have h := succFn_spec i
    rw [h_succFn_eq] at h
    exact isGLB_Ioc_of_isGLB_Ioi hij_lt h
  have hi_mem : i ∈ Finset.Ioc i j := by
    refine' Finset.is_glb_mem _ h_glb _
    exact ⟨_, Finset.mem_Ioc.mpr ⟨hij_lt, le_rfl⟩⟩
  rw [Finset.mem_Ioc] at hi_mem
  exact lt_irrefl i hi_mem.1
#align linear_locally_finite_order.is_max_of_succ_fn_le LinearLocallyFiniteOrder.isMax_of_succFn_le

theorem succFn_le_of_lt (i j : ι) (hij : i < j) : succFn i ≤ j := by
  have h := succFn_spec i
  rw [IsGLB, IsGreatest, mem_lowerBounds] at h
  exact h.1 j hij
#align linear_locally_finite_order.succ_fn_le_of_lt LinearLocallyFiniteOrder.succFn_le_of_lt

theorem le_of_lt_succFn (j i : ι) (hij : j < succFn i) : j ≤ i := by
  rw [lt_isGLB_iff (succFn_spec i)] at hij
  obtain ⟨k, hk_lb, hk⟩ := hij
  rw [mem_lowerBounds] at hk_lb
  exact not_lt.mp fun hi_lt_j ↦ not_le.mpr hk (hk_lb j hi_lt_j)
#align linear_locally_finite_order.le_of_lt_succ_fn LinearLocallyFiniteOrder.le_of_lt_succFn

noncomputable instance (priority := 100) [LocallyFiniteOrder ι] : SuccOrder ι where
  succ := succFn
  le_succ := le_succFn
  max_of_succ_le h := isMax_of_succFn_le _ h
  succ_le_of_lt h := succFn_le_of_lt _ _ h
  le_of_lt_succ h := le_of_lt_succFn _ _ h

noncomputable instance (priority := 100) [LocallyFiniteOrder ι] : PredOrder ι :=
  (inferInstance : PredOrder (OrderDual ιᵒᵈ))

end LinearLocallyFiniteOrder

instance (priority := 100) LinearLocallyFiniteOrder.isSuccArchimedean [LocallyFiniteOrder ι] :
    IsSuccArchimedean ι where
  exists_succ_iterate_of_le := by
    intro i j hij
    rw [le_iff_lt_or_eq] at hij
    cases' hij with hij hij
    swap
    · refine' ⟨0, _⟩
      simpa only [Function.iterate_zero, id.def] using hij
    by_contra h
    push_neg at h
    have h_lt : ∀ n, (succ^[n]) i < j := by
      intro n
      induction' n with n hn
      · simpa only [Function.iterate_zero, id.def] using hij
      · refine' lt_of_le_of_ne _ (h _)
        rw [Function.iterate_succ', Function.comp_apply]
        exact succ_le_of_lt hn
    have h_mem : ∀ n, (succ^[n]) i ∈ Finset.Icc i j :=
      fun n ↦ Finset.mem_Icc.mpr ⟨le_succ_iterate n i, (h_lt n).le⟩
    obtain ⟨n, m, hnm, h_eq⟩ : ∃ n m, n < m ∧ (succ^[n]) i = (succ^[m]) i := by
      let f : ℕ → Finset.Icc i j := fun n ↦ ⟨(succ^[n]) i, h_mem n⟩
      obtain ⟨n, m, hnm_ne, hfnm⟩ : ∃ n m, n ≠ m ∧ f n = f m
      exact Finite.exists_ne_map_eq_of_infinite f
      have hnm_eq : (succ^[n]) i = (succ^[m]) i := by simpa only [Subtype.mk_eq_mk] using hfnm
      cases' le_total n m with h_le h_le
      · exact ⟨n, m, lt_of_le_of_ne h_le hnm_ne, hnm_eq⟩
      · exact ⟨m, n, lt_of_le_of_ne h_le hnm_ne.symm, hnm_eq.symm⟩
    have h_max : IsMax ((succ^[n]) i) := isMax_iterate_succ_of_eq_of_ne h_eq hnm.ne
    exact not_le.mpr (h_lt n) (h_max (h_lt n).le)
#align linear_locally_finite_order.is_succ_archimedean LinearLocallyFiniteOrder.isSuccArchimedean

instance (priority := 100) LinearOrder.isPredArchimedean_of_isSuccArchimedean [SuccOrder ι]
    [PredOrder ι] [IsSuccArchimedean ι] : IsPredArchimedean ι where
  exists_pred_iterate_of_le := by
    intro i j hij
    have h_exists := exists_succ_iterate_of_le hij
    obtain ⟨n, hn_eq, hn_lt_ne⟩ : ∃ n, (succ^[n]) i = j ∧ ∀ m < n, (succ^[m]) i ≠ j
    exact ⟨Nat.find h_exists, Nat.find_spec h_exists, fun m hmn ↦ Nat.find_min h_exists hmn⟩
    refine' ⟨n, _⟩
    rw [← hn_eq]
    induction' n with n
    · simp only [Nat.zero_eq, Function.iterate_zero, id.def]
    · rw [pred_succ_iterate_of_not_isMax]
      rw [Nat.succ_sub_succ_eq_sub, tsub_zero]
      suffices : (succ^[n]) i < (succ^[n.succ]) i
      exact not_isMax_of_lt this
      refine' lt_of_le_of_ne _ _
      · rw [Function.iterate_succ']
        exact le_succ _
      · rw [hn_eq]
        exact hn_lt_ne _ (Nat.lt_succ_self n)
#align linear_order.pred_archimedean_of_succ_archimedean LinearOrder.isPredArchimedean_of_isSuccArchimedean

section toZ

variable [SuccOrder ι] [IsSuccArchimedean ι] [PredOrder ι] {i0 i : ι}

-- For "to_Z"
set_option linter.uppercaseLean3 false

/-- `toZ` numbers elements of `ι` according to their order, starting from `i0`. We prove in
`orderIsoRangeToZOfLinearSuccPredArch` that this defines an `OrderIso` between `ι` and
the range of `toZ`. -/
def toZ (i0 i : ι) : ℤ :=
  dite (i0 ≤ i) (fun hi ↦ Nat.find (exists_succ_iterate_of_le hi)) fun hi ↦
    -Nat.find (exists_pred_iterate_of_le (not_le.mp hi).le)
#align to_Z toZ

theorem toZ_of_ge (hi : i0 ≤ i) : toZ i0 i = Nat.find (exists_succ_iterate_of_le hi) :=
  dif_pos hi
#align to_Z_of_ge toZ_of_ge

theorem toZ_of_lt (hi : i < i0) : toZ i0 i = -Nat.find (exists_pred_iterate_of_le hi.le) :=
  dif_neg (not_le.mpr hi)
#align to_Z_of_lt toZ_of_lt

@[simp]
theorem toZ_of_eq : toZ i0 i0 = 0 := by
  rw [toZ_of_ge le_rfl]
  norm_cast
  refine' le_antisymm (Nat.find_le _) (zero_le _)
  rw [Function.iterate_zero, id.def]
#align to_Z_of_eq toZ_of_eq

theorem iterate_succ_toZ (i : ι) (hi : i0 ≤ i) : (succ^[(toZ i0 i).toNat]) i0 = i := by
  rw [toZ_of_ge hi, Int.toNat_coe_nat]
  exact Nat.find_spec (exists_succ_iterate_of_le hi)
#align iterate_succ_to_Z iterate_succ_toZ

theorem iterate_pred_toZ (i : ι) (hi : i < i0) : (pred^[(-toZ i0 i).toNat]) i0 = i := by
  rw [toZ_of_lt hi, neg_neg, Int.toNat_coe_nat]
  exact Nat.find_spec (exists_pred_iterate_of_le hi.le)
#align iterate_pred_to_Z iterate_pred_toZ

theorem toZ_nonneg (hi : i0 ≤ i) : 0 ≤ toZ i0 i := by
  rw [toZ_of_ge hi]
  exact Nat.cast_nonneg _
#align to_Z_nonneg toZ_nonneg

theorem toZ_neg (hi : i < i0) : toZ i0 i < 0 := by
  refine' lt_of_le_of_ne _ _
  · rw [toZ_of_lt hi, neg_nonpos]
    exact Nat.cast_nonneg _
  · by_contra h
    have h_eq := iterate_pred_toZ i hi
    rw [← h_eq, h] at hi
    simp only [neg_zero, Int.toNat_zero, Function.iterate_zero, id.def, lt_self_iff_false] at hi
#align to_Z_neg toZ_neg

theorem toZ_iterate_succ_le (n : ℕ) : toZ i0 ((succ^[n]) i0) ≤ n := by
  rw [toZ_of_ge (le_succ_iterate _ _)]
  norm_cast
  exact Nat.find_min' _ rfl
#align to_Z_iterate_succ_le toZ_iterate_succ_le

theorem toZ_iterate_pred_ge (n : ℕ) : -(n : ℤ) ≤ toZ i0 ((pred^[n]) i0) := by
  cases' le_or_lt i0 ((pred^[n]) i0) with h h
  · have h_eq : (pred^[n]) i0 = i0 := le_antisymm (pred_iterate_le _ _) h
    rw [h_eq, toZ_of_eq]
    simp only [Right.neg_nonpos_iff, Nat.cast_nonneg]
  · rw [toZ_of_lt h, neg_le_neg_iff]
    norm_cast
    exact Nat.find_min' _ rfl
#align to_Z_iterate_pred_ge toZ_iterate_pred_ge

theorem toZ_iterate_succ_of_not_isMax (n : ℕ) (hn : ¬IsMax ((succ^[n]) i0)) :
    toZ i0 ((succ^[n]) i0) = n := by
  let m := (toZ i0 ((succ^[n]) i0)).toNat
  have h_eq : (succ^[m]) i0 = (succ^[n]) i0 := iterate_succ_toZ _ (le_succ_iterate _ _)
  by_cases hmn : m = n
  · nth_rw 2 [← hmn]
    rw [Int.toNat_eq_max, toZ_of_ge (le_succ_iterate _ _), max_eq_left]
    exact Nat.cast_nonneg _
  suffices : IsMax ((succ^[n]) i0); exact absurd this hn
  exact isMax_iterate_succ_of_eq_of_ne h_eq.symm (Ne.symm hmn)
#align to_Z_iterate_succ_of_not_is_max toZ_iterate_succ_of_not_isMax

theorem toZ_iterate_pred_of_not_isMin (n : ℕ) (hn : ¬IsMin ((pred^[n]) i0)) :
    toZ i0 ((pred^[n]) i0) = -n := by
  cases' n with n n
  · simp only [Nat.zero_eq, Function.iterate_zero, id.def, toZ_of_eq, Nat.cast_zero, neg_zero]
  have : (pred^[n.succ]) i0 < i0 := by
    refine' lt_of_le_of_ne (pred_iterate_le _ _) fun h_pred_iterate_eq ↦ hn _
    have h_pred_eq_pred : (pred^[n.succ]) i0 = (pred^[0]) i0 := by
      rwa [Function.iterate_zero, id.def]
    exact isMin_iterate_pred_of_eq_of_ne h_pred_eq_pred (Nat.succ_ne_zero n)
  let m := (-toZ i0 ((pred^[n.succ]) i0)).toNat
  have h_eq : (pred^[m]) i0 = (pred^[n.succ]) i0 := iterate_pred_toZ _ this
  by_cases hmn : m = n.succ
  · nth_rw 2 [← hmn]
    rw [Int.toNat_eq_max, toZ_of_lt this, max_eq_left, neg_neg]
    rw [neg_neg]
    exact Nat.cast_nonneg _
  · suffices : IsMin ((pred^[n.succ]) i0)
    exact absurd this hn
    exact isMin_iterate_pred_of_eq_of_ne h_eq.symm (Ne.symm hmn)
#align to_Z_iterate_pred_of_not_is_min toZ_iterate_pred_of_not_isMin

theorem le_of_toZ_le {j : ι} (h_le : toZ i0 i ≤ toZ i0 j) : i ≤ j := by
  cases' le_or_lt i0 i with hi hi <;> cases' le_or_lt i0 j with hj hj
  · rw [← iterate_succ_toZ i hi, ← iterate_succ_toZ j hj]
    exact Monotone.monotone_iterate_of_le_map succ_mono (le_succ _) (Int.toNat_le_toNat h_le)
  · exact absurd ((toZ_neg hj).trans_le (toZ_nonneg hi)) (not_lt.mpr h_le)
  · exact hi.le.trans hj
  · rw [← iterate_pred_toZ i hi, ← iterate_pred_toZ j hj]
    refine' Monotone.antitone_iterate_of_map_le pred_mono (pred_le _) (Int.toNat_le_toNat _)
    exact neg_le_neg h_le
#align le_of_to_Z_le le_of_toZ_le

theorem toZ_mono {i j : ι} (h_le : i ≤ j) : toZ i0 i ≤ toZ i0 j := by
  by_cases hi_max : IsMax i
  · rw [le_antisymm h_le (hi_max h_le)]
  by_cases hj_min : IsMin j
  · rw [le_antisymm h_le (hj_min h_le)]
  cases' le_or_lt i0 i with hi hi <;> cases' le_or_lt i0 j with hj hj
  · let m := Nat.find (exists_succ_iterate_of_le h_le)
    have hm : (succ^[m]) i = j := Nat.find_spec (exists_succ_iterate_of_le h_le)
    have hj_eq : j = (succ^[(toZ i0 i).toNat + m]) i0 := by
      rw [← hm, add_comm]
      nth_rw 1 [← iterate_succ_toZ i hi]
      rw [Function.iterate_add]
      rfl
    by_contra h
    by_cases hm0 : m = 0
    · rw [hm0, Function.iterate_zero, id.def] at hm
      rw [hm] at h
      exact h (le_of_eq rfl)
    refine' hi_max (max_of_succ_le (le_trans _ (@le_of_toZ_le _ _ _ _ _ i0 j i _)))
    · have h_succ_le : (succ^[(toZ i0 i).toNat + 1]) i0 ≤ j := by
        rw [hj_eq]
        refine' Monotone.monotone_iterate_of_le_map succ_mono (le_succ i0) (add_le_add_left _ _)
        exact Nat.one_le_iff_ne_zero.mpr hm0
      rwa [Function.iterate_succ', Function.comp_apply, iterate_succ_toZ i hi] at h_succ_le
    · exact le_of_not_le h
  · exact absurd h_le (not_le.mpr (hj.trans_le hi))
  · exact (toZ_neg hi).le.trans (toZ_nonneg hj)
  · let m := Nat.find (exists_pred_iterate_of_le h_le)
    have hm : (pred^[m]) j = i := Nat.find_spec (exists_pred_iterate_of_le h_le)
    have hj_eq : i = (pred^[(-toZ i0 j).toNat + m]) i0 := by
      rw [← hm, add_comm]
      nth_rw 1 [← iterate_pred_toZ j hj]
      rw [Function.iterate_add]
      rfl
    by_contra h
    by_cases hm0 : m = 0
    · rw [hm0, Function.iterate_zero, id.def] at hm
      rw [hm] at h
      exact h (le_of_eq rfl)
    refine' hj_min (min_of_le_pred _)
    refine' (@le_of_toZ_le _ _ _ _ _ i0 j i _).trans _
    · exact le_of_not_le h
    · have h_le_pred : i ≤ (pred^[(-toZ i0 j).toNat + 1]) i0 := by
        rw [hj_eq]
        refine' Monotone.antitone_iterate_of_map_le pred_mono (pred_le i0) (add_le_add_left _ _)
        exact Nat.one_le_iff_ne_zero.mpr hm0
      rwa [Function.iterate_succ', Function.comp_apply, iterate_pred_toZ j hj] at h_le_pred
#align to_Z_mono toZ_mono

theorem toZ_le_iff (i j : ι) : toZ i0 i ≤ toZ i0 j ↔ i ≤ j :=
  ⟨le_of_toZ_le, toZ_mono⟩
#align to_Z_le_iff toZ_le_iff

theorem toZ_iterate_succ [NoMaxOrder ι] (n : ℕ) : toZ i0 ((succ^[n]) i0) = n :=
  toZ_iterate_succ_of_not_isMax n (not_isMax _)
#align to_Z_iterate_succ toZ_iterate_succ

theorem toZ_iterate_pred [NoMinOrder ι] (n : ℕ) : toZ i0 ((pred^[n]) i0) = -n :=
  toZ_iterate_pred_of_not_isMin n (not_isMin _)
#align to_Z_iterate_pred toZ_iterate_pred

theorem injective_toZ : Function.Injective (toZ i0) :=
  fun _ _ h ↦ le_antisymm (le_of_toZ_le h.le) (le_of_toZ_le h.symm.le)
#align injective_to_Z injective_toZ

end toZ

section OrderIso

variable [SuccOrder ι] [PredOrder ι] [IsSuccArchimedean ι]

/-- `toZ` defines an `OrderIso` between `ι` and its range. -/
noncomputable def orderIsoRangeToZOfLinearSuccPredArch [hι : Nonempty ι] :
    ι ≃o Set.range (toZ hι.some) where
  toEquiv := Equiv.ofInjective _ injective_toZ
  map_rel_iff' := by intro i j ; exact toZ_le_iff i j
set_option linter.uppercaseLean3 false in
#align order_iso_range_to_Z_of_linear_succ_pred_arch orderIsoRangeToZOfLinearSuccPredArch

instance (priority := 100) countable_of_linear_succ_pred_arch : Countable ι := by
  cases' isEmpty_or_nonempty ι with _ hι
  · infer_instance
  · exact Countable.of_equiv _ orderIsoRangeToZOfLinearSuccPredArch.symm.toEquiv
#align countable_of_linear_succ_pred_arch countable_of_linear_succ_pred_arch

/-- If the order has neither bot nor top, `toZ` defines an `OrderIso` between `ι` and `ℤ`. -/
noncomputable def orderIsoIntOfLinearSuccPredArch [NoMaxOrder ι] [NoMinOrder ι] [hι : Nonempty ι] :
    ι ≃o ℤ where
  toFun := toZ hι.some
  invFun n := if 0 ≤ n then (succ^[n.toNat]) hι.some else (pred^[(-n).toNat]) hι.some
  left_inv i := by
    cases' le_or_lt hι.some i with hi hi
    · have h_nonneg : 0 ≤ toZ hι.some i := toZ_nonneg hi
      simp_rw [if_pos h_nonneg]
      exact iterate_succ_toZ i hi
    · have h_neg : toZ hι.some i < 0 := toZ_neg hi
      simp_rw [if_neg (not_le.mpr h_neg)]
      exact iterate_pred_toZ i hi
  right_inv n := by
    cases' le_or_lt 0 n with hn hn
    · simp_rw [if_pos hn]
      rw [toZ_iterate_succ]
      exact Int.toNat_of_nonneg hn
    · simp_rw [if_neg (not_le.mpr hn)]
      rw [toZ_iterate_pred]
      simp only [hn.le, Int.toNat_of_nonneg, Right.nonneg_neg_iff, neg_neg]
  map_rel_iff' := by intro i j ; exact toZ_le_iff i j
#align order_iso_int_of_linear_succ_pred_arch orderIsoIntOfLinearSuccPredArch

/-- If the order has a bot but no top, `toZ` defines an `OrderIso` between `ι` and `ℕ`. -/
def orderIsoNatOfLinearSuccPredArch [NoMaxOrder ι] [OrderBot ι] : ι ≃o ℕ where
  toFun i := (toZ ⊥ i).toNat
  invFun n := (succ^[n]) ⊥
  left_inv i := by
    simp_rw [if_pos (toZ_nonneg bot_le)]
    exact iterate_succ_toZ i bot_le
  right_inv n := by
    simp_rw [if_pos bot_le]
    rw [toZ_iterate_succ]
    exact Int.toNat_coe_nat n
  map_rel_iff' := by
    intro i j
    simp only [Equiv.coe_fn_mk, Int.toNat_le]
    rw [← @toZ_le_iff ι _ _ _ _ ⊥, Int.toNat_of_nonneg (toZ_nonneg bot_le)]
#align order_iso_nat_of_linear_succ_pred_arch orderIsoNatOfLinearSuccPredArch

/-- If the order has both a bot and a top, `toZ` gives an `OrderIso` between `ι` and
`Finset.range n` for some `n`. -/
def orderIsoRangeOfLinearSuccPredArch [OrderBot ι] [OrderTop ι] :
    ι ≃o Finset.range ((toZ ⊥ (⊤ : ι)).toNat + 1) where
  toFun i :=
    ⟨(toZ ⊥ i).toNat,
      Finset.mem_range_succ_iff.mpr (Int.toNat_le_toNat ((toZ_le_iff _ _).mpr le_top))⟩
  invFun n := (succ^[n]) ⊥
  left_inv i := iterate_succ_toZ i bot_le
  right_inv n := by
    ext1
    simp only [Subtype.coe_mk]
    refine' le_antisymm _ _
    · rw [Int.toNat_le]
      exact toZ_iterate_succ_le _
    by_cases hn_max : IsMax ((succ^[↑n]) (⊥ : ι))
    · rw [← isTop_iff_isMax, isTop_iff_eq_top] at hn_max
      rw [hn_max]
      exact Nat.lt_succ_iff.mp (Finset.mem_range.mp n.prop)
    · rw [toZ_iterate_succ_of_not_isMax _ hn_max]
      simp only [Int.toNat_coe_nat, le_refl]
  map_rel_iff' := by
    intro i j
    simp only [Equiv.coe_fn_mk, Subtype.mk_le_mk, Int.toNat_le]
    rw [← @toZ_le_iff ι _ _ _ _ ⊥, Int.toNat_of_nonneg (toZ_nonneg bot_le)]
#align order_iso_range_of_linear_succ_pred_arch orderIsoRangeOfLinearSuccPredArch

end OrderIso


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.topology
import data.nat.parity

namespace affine

open_locale classical affine big_operators
open set
variables {m n : ℕ}
local notation `E` := fin m → ℝ
variables {S : simplicial_complex E} {f : E → fin m}

def is_sperner_colouring (S : simplicial_complex E)
  (f : E → fin m) : Prop :=
∀ (x : E) i, x ∈ S.points → x i = 0 → f x ≠ i

def panchromatic (f : (fin n → ℝ) → fin m) (X : finset (fin n → ℝ)) :=
  X.image f = finset.univ

lemma panchromatic_iff (f : E → fin m) (X : finset E) :
  panchromatic f X ↔ (X.image f).card = m :=
begin
  rw panchromatic,
  split,
  { intro h,
    simp [h] },
  { intro h,
    refine finset.eq_of_subset_of_card_le (finset.image f X).subset_univ _,
    simp [h] }
end

lemma std_simplex_one :
  std_simplex (fin 1) = { ![(1 : ℝ)]} :=
begin
  ext x,
  simp [std_simplex_eq_inter],
  split,
  { rintro ⟨-, hx⟩,
    ext i,
    have : i = 0 := subsingleton.elim _ _,
    rw this,
    apply hx },
  { rintro rfl,
    refine ⟨λ _, _, rfl⟩,
    simp only [matrix.cons_val_fin_one],
    apply zero_le_one }
end

lemma strong_sperner_zero_aux {S : simplicial_complex (fin 1 → ℝ)}
  (hS₁ : S.space = std_simplex (fin 1)) :
  S.faces = {∅, { ![1]}} :=
begin
  have X_subs : ∀ X ∈ S.faces, X ⊆ { ![(1:ℝ)]},
  { rintro X hX,
    have := face_subset_space hX,
    rw [hS₁, std_simplex_one] at this,
    rintro x hx,
    simpa using this hx },
  have : ∃ X ∈ S.faces, X = { ![(1:ℝ)]},
  { have std_eq := hS₁,
    have one_mem : ![(1:ℝ)] ∈ std_simplex (fin 1),
    { rw std_simplex_one,
      simp },
    rw [←std_eq, simplicial_complex.space, set.mem_bUnion_iff] at one_mem,
    rcases one_mem with ⟨X, hX₁, hX₂⟩,
    refine ⟨X, hX₁, _⟩,
    have := X_subs X hX₁,
    rw finset.subset_singleton_iff at this,
    rcases this with (rfl | rfl),
    { simp only [finset.coe_empty] at hX₂,
      rw convex_hull_empty at hX₂,
      apply hX₂.elim },
    { refl } },
  ext X,
  simp only [set.mem_insert_iff, set.mem_singleton_iff, ←finset.subset_singleton_iff],
  split,
  { intro hX,
    apply X_subs _ hX },
  { intro hX,
    rcases this with ⟨Y, hY₁, rfl⟩,
    exact S.down_closed hY₁ hX },
end

theorem strong_sperner_zero {S : simplicial_complex (fin 1 → ℝ)}
  (hS₁ : S.space = std_simplex (fin 1)) (hS₂ : S.finite)
  (f : (fin 1 → ℝ) → fin 1) :
  odd ((S.faces_finset hS₂).filter (panchromatic f)).card :=
begin
  have : (S.faces_finset hS₂).filter (panchromatic f) = {{ ![(1:ℝ)]}},
  { ext X,
    simp only [mem_faces_finset, finset.mem_singleton, finset.mem_filter,
      strong_sperner_zero_aux hS₁, mem_insert_iff, mem_singleton_iff],
    split,
    { rintro ⟨(rfl | rfl), h⟩,
      { change _ = _ at h,
        rw [univ_unique, fin.default_eq_zero, finset.image_empty, eq_comm] at h,
        simp only [finset.singleton_ne_empty] at h,
        cases h },
      { refl } },
    rintro rfl,
    refine ⟨or.inr rfl, _⟩,
    change _ = _,
    simp only [fin.default_eq_zero, finset.image_singleton, univ_unique],
    rw finset.singleton_inj,
    apply subsingleton.elim },
  rw this,
  simp,
end

-- { faces := {X ∈ S.faces | ∀ (x : fin (m+1) → ℝ), x ∈ X → x 0 = 0 },
-- := finset.image matrix.vec_tail '' S.faces,

lemma affine_independent_proj {ι : Type*}
  {p : ι → fin (n+1) → ℝ}
  (hp₁ : ∀ i, p i 0 = 0)
  (hp₂ : affine_independent ℝ p) :
  affine_independent ℝ (matrix.vec_tail ∘ p) :=
begin
  rw affine_independent_def,
  intros s w hw hs i hi,
  rw finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero _ _ _ hw (0:fin n → ℝ) at hs,
  rw finset.weighted_vsub_of_point_apply at hs,
  simp only [vsub_eq_sub, function.comp_app, sub_zero] at hs,
  have : s.weighted_vsub p w = (0:fin (n+1) → ℝ),
  { rw finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero _ _ _ hw (0:fin (n+1) → ℝ),
    rw finset.weighted_vsub_of_point_apply,
    simp only [vsub_eq_sub, sub_zero],
    ext j,
    simp only [pi.zero_apply],
    rw finset.sum_apply _ s (λ i, w i • p i),
    refine fin.cases _ _ j,
    { simp [hp₁] },
    intro j,
    dsimp,
    rw function.funext_iff at hs,
    specialize hs j,
    simp only [pi.zero_apply] at hs,
    rw finset.sum_apply _ s (λ i, w i • matrix.vec_tail (p i)) at hs,
    dsimp [matrix.vec_tail] at hs,
    apply hs },
  exact hp₂ s w hw this i hi,
end

lemma is_linear_map_matrix_vec_tail :
  is_linear_map ℝ (matrix.vec_tail : (fin n.succ → ℝ) → (fin n → ℝ)) :=
{ map_add := by simp,
  map_smul := λ c x,
  begin
    ext i,
    simp [matrix.vec_tail],
  end }

-- TODO: this generalises to affine subspaces
lemma convex_hull_affine {X : finset (fin m.succ → ℝ)}
  (hX₂ : ∀ (x : fin (m + 1) → ℝ), x ∈ X → x 0 = 0)
  {x : fin m.succ → ℝ} (hx : x ∈ convex_hull (X : set (fin m.succ → ℝ))) :
  x 0 = 0 :=
begin
  rw finset.convex_hull_eq at hx,
  rcases hx with ⟨w, hw₀, hw₁, rfl⟩,
  rw X.center_mass_eq_of_sum_1 _ hw₁,
  dsimp,
  rw finset.sum_apply 0 _ (λ i, w i • i),
  dsimp,
  replace hX₂ : ∀ x ∈ X, w x * x 0 = 0,
  { intros x hx,
    rw hX₂ x hx,
    simp },
  rw finset.sum_congr rfl hX₂,
  simp,
end

noncomputable def simplicial_complex.dimension_drop (S : simplicial_complex (fin m.succ → ℝ)) :
  simplicial_complex E :=
{ faces := {Y | ∃ X ∈ S.faces, finset.image matrix.vec_tail X = Y ∧
    ∀ (x : fin (m+1) → ℝ), x ∈ X → x 0 = 0 },
  down_closed :=
  begin
    rintro _ Y ⟨X, hX₁, rfl, hX₂⟩ YX,
    refine ⟨Y.image (matrix.vec_cons 0), _, _⟩,
    { apply S.down_closed hX₁,
      rw finset.image_subset_iff,
      rintro y hY,
      have := YX hY,
      simp only [exists_prop, finset.mem_image] at this,
      obtain ⟨x, hx, rfl⟩ := this,
      suffices : matrix.vec_head x = 0,
      { rw ← this,
        simpa },
      apply hX₂ _ hx },
    rw finset.image_image,
    refine ⟨_, _⟩,
    { convert finset.image_id,
      { ext x,
        dsimp,
        simp, },
      { exact classical.dec_eq E } },
    simp,
  end,
  indep :=
  begin
    rintro _ ⟨X, hX₁, rfl, hX₂⟩,
    let f : ((finset.image matrix.vec_tail X : set (fin m → ℝ))) → (X : set (fin (m+1) → ℝ)),
    { intro t,
      refine ⟨matrix.vec_cons 0 t.1, _⟩,
      rcases t with ⟨t, ht⟩,
      simp only [set.mem_image, finset.mem_coe, finset.coe_image] at ht,
      rcases ht with ⟨x, hx, rfl⟩,
      suffices : matrix.vec_head x = 0,
      { rw ← this,
        simpa },
      apply hX₂ x hx },
    have hf : function.injective f,
    { rintro ⟨x₁, hx₁⟩ ⟨x₂, hx₂⟩ h,
      rw subtype.ext_iff at h,
      change matrix.vec_cons _ x₁ = matrix.vec_cons _ x₂ at h,
      apply subtype.ext,
      apply_fun matrix.vec_tail at h,
      simpa using h },
    have := affine_independent_proj _ (S.indep hX₁),
    { convert affine_independent_embedding_of_affine_independent ⟨f, hf⟩ this,
      ext p,
      dsimp,
      simp
      },
    rintro ⟨i, hi⟩,
    apply hX₂ _ hi,
  end,
  disjoint :=
  begin
    rintro _ _ ⟨X, hX₁, rfl, hX₂⟩ ⟨Y, hY₁, rfl, hY₂⟩,
    simp only [finset.coe_image],
    rw ← is_linear_map.image_convex_hull,
    rw ← is_linear_map.image_convex_hull,

    rw set.image_inter_on,
    refine set.subset.trans (set.image_subset matrix.vec_tail (S.disjoint hX₁ hY₁)) _,
    rw is_linear_map.image_convex_hull,
    apply convex_hull_mono,
    apply set.image_inter_subset,
    apply is_linear_map_matrix_vec_tail,
    { intros x hx y hy h,
      rw ← matrix.cons_head_tail x,
      rw ← matrix.cons_head_tail y,
      rw h,
      suffices : matrix.vec_head x = 0 ∧ matrix.vec_head y = 0,
      { rw [this.1, this.2] },
      refine ⟨_, _⟩,
      apply convex_hull_affine _ hx,
      apply hY₂,
      apply convex_hull_affine _ hy,
      apply hX₂, },
    apply is_linear_map_matrix_vec_tail,
    apply is_linear_map_matrix_vec_tail,
  end }

theorem strong_sperner {S : simplicial_complex (fin (m+1) → ℝ)} {f}
  (hS₁ : S.space = std_simplex (fin (m+1))) (hS₂ : S.finite) (hS₃ : S.full_dimensional)
  (hf : is_sperner_colouring S f) :
  odd ((S.faces_finset hS₂).filter (panchromatic f)).card :=
begin
  tactic.unfreeze_local_instances,
  induction m with n ih generalizing f,
  { apply strong_sperner_zero hS₁ },
  sorry
end

theorem sperner {S : simplicial_complex (fin (m+1) → ℝ)}
  (hS₁ : S.space = std_simplex (fin (m+1))) (hS₂ : S.finite) (hS₃ : S.full_dimensional)
  {f} (hf : is_sperner_colouring S f) :
  ∃ X ∈ S.faces, panchromatic f X :=
begin
  obtain ⟨X, hX⟩ := finset.card_pos.1 (nat.odd_gt_zero (strong_sperner hS₁ hS₂ hS₃ hf)),
  simp only [mem_faces_finset, finset.mem_filter] at hX,
  exact ⟨_, hX.1, hX.2⟩,
end

end affine


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.algebra.module
import topology.instances.real

/-!
# Continuous additive maps are `ℝ`-linear

In this file we prove that a continuous map `f : E →+ F` between two topological vector spaces
over `ℝ` is `ℝ`-linear
-/

variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E]
  [has_continuous_smul ℝ E] {F : Type*} [add_comm_group F] [module ℝ F]
  [topological_space F] [has_continuous_smul ℝ F] [t2_space F]

namespace add_monoid_hom

/-- A continuous additive map between two vector spaces over `ℝ` is `ℝ`-linear. -/
lemma map_real_smul (f : E →+ F) (hf : continuous f) (c : ℝ) (x : E) :
  f (c • x) = c • f x :=
suffices (λ c : ℝ, f (c • x)) = λ c : ℝ, c • f x, from _root_.congr_fun this c,
rat.dense_embedding_coe_real.dense.equalizer
  (hf.comp $ continuous_id.smul continuous_const)
  (continuous_id.smul continuous_const)
  (funext $ λ r, f.map_rat_cast_smul ℝ ℝ r x)

/-- Reinterpret a continuous additive homomorphism between two real vector spaces
as a continuous real-linear map. -/
def to_real_linear_map (f : E →+ F) (hf : continuous f) : E →L[ℝ] F :=
⟨{ to_fun := f, map_add' := f.map_add, map_smul' := f.map_real_smul hf }, hf⟩

@[simp] lemma coe_to_real_linear_map (f : E →+ F) (hf : continuous f) :
  ⇑(f.to_real_linear_map hf) = f := rfl

end add_monoid_hom


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import data.nat.prime
import data.rat.basic
import order.well_founded
import tactic.linarith
import tactic.omega

/-!
# IMO 1988 Q6 and constant descent Vieta jumping

Question 6 of IMO1988 is somewhat (in)famous. Several expert problem solvers
could not tackle the question within the given time limit.
The problem lead to the introduction of a new proof technique,
so called “Vieta jumping”.

In this file we formalise constant descent Vieta jumping,
and apply this to prove Q6 of IMO1988.
To illustrate the technique, we also prove a similar result.
-/

-- open_locale classical

local attribute [instance] classical.prop_decidable
local attribute [simp] sq

/-- Constant descent Vieta jumping.

This proof technique allows one to prove an arbitrary proposition `claim`,
by running a descent argument on a hyperbola `H` in the first quadrant of the plane,
under the following conditions:

* `h₀`     : There exists an integral point `(x,y)` on the hyperbola `H`.
* `H_symm` : The hyperbola has a symmetry along the diagonal in the plane.
* `H_zero` : If an integral point `(x,0)` lies on the hyperbola `H`, then `claim` is true.
* `H_diag` : If an integral point `(x,x)` lies on the hyperbola `H`, then `claim` is true.
* `H_desc` : If `(x,y)` is an integral point on the hyperbola `H`,
with `x < y` then there exists a “smaller” point on `H`: a point `(x',y')` with `x' < y' ≤ x`.

For reasons of usability, the hyperbola `H` is implemented as an arbitrary predicate.
(In question 6 of IMO1988, where this proof technique was first developped,
the predicate `claim` would be `∃ (d : ℕ), d ^ 2 = k` for some natural number `k`,
and the predicate `H` would be `λ a b, a * a + b * b = (a * b + 1) * k`.)

To ensure that the predicate `H` actually describes a hyperbola,
the user must provide arguments `B` and `C` that are used as coefficients for a quadratic equation.
Finally, `H_quad` is the proof obligation that the quadratic equation
  `(y:ℤ) * y - B x * y + C x = 0`
describes the same hyperbola as the predicate `H`.

For extra flexibility, one must provide a predicate `base` on the integral points in the plane.
In the descent step `H_desc` this will give the user the additional assumption that
the point `(x,y)` does not lie in this base locus.
The user must provide a proof that the proposition `claim` is true
if there exists an integral point `(x,y)` on the hyperbola `H` that lies in the base locus.
If such a base locus is not necessary, once can simply let it be `λ x y, false`.
-/
lemma constant_descent_vieta_jumping (x y : ℕ) {claim : Prop} {H : ℕ → ℕ → Prop}
  (h₀ : H x y) (B : ℕ → ℤ) (C : ℕ → ℤ) (base : ℕ → ℕ → Prop)
  (H_quad : ∀ {x y}, H x y ↔ (y:ℤ) * y - B x * y + C x = 0) (H_symm : ∀ {x y}, H x y ↔ H y x)
  (H_zero : ∀ {x}, H x 0 → claim) (H_diag : ∀ {x}, H x x → claim)
  (H_desc : ∀ {x y}, 0 < x → x < y → ¬base x y → H x y →
    ∀ y', y' * y' - B x * y' + C x = 0 → y' = B x - y → y' * y = C x → 0 ≤ y' ∧ y' ≤ x)
  (H_base : ∀ {x y}, H x y → base x y → claim) :
  claim :=
begin
  -- First of all, we may assume that x ≤ y.
  -- We justify this using H_symm.
  wlog hxy : x ≤ y, swap, { rw H_symm at h₀, solve_by_elim },
  -- In fact, we can easily deal with the case x = y.
  by_cases x_eq_y : x = y, {subst x_eq_y, exact H_diag h₀},
  -- Hence we may assume that x < y.
  replace hxy : x < y := lt_of_le_of_ne hxy x_eq_y, clear x_eq_y,
  -- Consider the upper branch of the hyperbola defined by H.
  let upper_branch : set (ℕ × ℕ) := {p | H p.1 p.2 ∧ p.1 < p.2},
  -- Note that the point p = (x,y) lies on the upper branch.
  let p : ℕ × ℕ := ⟨x,y⟩,
  have hp : p ∈ upper_branch := ⟨h₀, hxy⟩,
  -- We also consider the exceptional set of solutions (a,b) that satisfy
  -- a = 0 or a = b or B a = b or B a = b + a or that lie in the base locus.
  let exceptional : set (ℕ × ℕ) :=
  {p | H p.1 p.2 ∧ (base p.1 p.2 ∨ p.1 = 0 ∨ p.1 = p.2 ∨ B p.1 = p.2 ∨ B p.1 = p.2 + p.1) },
  -- Let S be the projection of the upper branch on to the y-axis
  -- after removing the exceptional locus.
  let S : set ℕ := prod.snd '' (upper_branch \ exceptional),
  -- The strategy is to show that the exceptional locus in nonempty
  -- by running a descent argument that starts with the given point p = (x,y).
  -- Our assumptions ensure that we can then prove the claim.
  suffices exc : exceptional.nonempty,
  { -- Suppose that there exists an element in the exceptional locus.
    simp [exceptional, -add_comm, set.nonempty] at exc,
    -- Let (a,b) be such an element, and consider all the possible cases.
    rcases exc with ⟨a, b, hH, hb⟩, rcases hb with _|rfl|rfl|hB|hB,
    -- The first three cases are rather easy to solve.
    { solve_by_elim },
    { rw H_symm at hH, solve_by_elim },
    { solve_by_elim },
    -- The final two cases are very similar.
    all_goals {
      -- Consider the quadratic equation that (a,b) satisfies.
      rw H_quad at hH,
      -- We find the other root of the equation, and Vieta's formulas.
      rcases Vieta_formula_quadratic hH with ⟨c, h_root, hV₁, hV₂⟩,
      -- By substitutions we find that b = 0 or b = a.
      simp [hB] at hV₁, subst hV₁,
      rw [← int.coe_nat_zero] at *,
      rw ← H_quad at h_root,
      -- And hence we are done by H_zero and H_diag.
      solve_by_elim } },
  -- To finish the main proof, we need to show that the exceptional locus is nonempty.
  -- So we assume that the exceptional locus is empty, and work towards dering a contradiction.
  rw ← set.ne_empty_iff_nonempty,
  assume exceptional_empty,
  -- Observe that S is nonempty.
  have S_nonempty : S.nonempty,
  { -- It contains the image of p.
    use p.2,
    apply set.mem_image_of_mem,
    -- After all, we assumed that the exceptional locus is empty.
    rwa [exceptional_empty, set.diff_empty], },
  -- We are now set for an infinite descent argument.
  -- Let m be the smallest element of the nonempty set S.
  let  m     : ℕ                := well_founded.min     nat.lt_wf S S_nonempty,
  have m_mem : m ∈ S            := well_founded.min_mem nat.lt_wf S S_nonempty,
  have m_min : ∀ k ∈ S, ¬ k < m := λ k hk, well_founded.not_lt_min nat.lt_wf S S_nonempty hk,
  -- It suffices to show that there is point (a,b) with b ∈ S and b < m.
  suffices hp' : ∃ p' : ℕ × ℕ, p'.2 ∈ S ∧ p'.2 < m,
  { rcases hp' with ⟨p', p'_mem, p'_small⟩, solve_by_elim },
  -- Let (m_x, m_y) be a point on the upper branch that projects to m ∈ S
  -- and that does not lie in the exceptional locus.
  rcases m_mem with ⟨⟨mx, my⟩, ⟨⟨hHm, mx_lt_my⟩, h_base⟩, m_eq⟩,
  -- This means that m_y = m,
  -- and the conditions H(m_x, m_y) and m_x < m_y are satisfied.
  simp [exceptional, hHm] at mx_lt_my h_base m_eq,
  push_neg at h_base,
  -- Finally, it also means that (m_x, m_y) does not lie in the base locus,
  -- that m_x ≠ 0, m_x ≠ m_y, B(m_x) ≠ m_y, and B(m_x) ≠ m_x + m_y.
  rcases h_base with ⟨h_base, hmx, hm_diag, hm_B₁, hm_B₂⟩,
  replace hmx : 0 < mx := pos_iff_ne_zero.mpr hmx,
  -- Consider the quadratic equation that (m_x, m_y) satisfies.
  have h_quad := hHm, rw H_quad at h_quad,
  -- We find the other root of the equation, and Vieta's formulas.
  rcases Vieta_formula_quadratic h_quad with ⟨c, h_root, hV₁, hV₂⟩,
  -- No we rewrite Vietas formulas a bit, and apply the descent step.
  replace hV₁ : c = B mx - my := eq_sub_of_add_eq' hV₁,
  rw mul_comm at hV₂,
  have Hc := H_desc hmx mx_lt_my h_base hHm c h_root hV₁ hV₂,
  -- This means that we may assume that c ≥ 0 and c ≤ m_x.
  cases Hc with c_nonneg c_lt,
  -- In other words, c is a natural number.
  lift c to ℕ using c_nonneg,
  -- Recall that we are trying find a point (a,b) such that b ∈ S and b < m.
  -- We claim that p' = (c, m_x) does the job.
  let p' : ℕ × ℕ := ⟨c, mx⟩,
  use p',
  -- The second condition is rather easy to check, so we do that first.
  split, swap,
  { rwa m_eq at mx_lt_my },
  -- Now we need to show that p' projects onto S. In other words, that c ∈ S.
  -- We do that, by showing that it lies in the upper branch
  -- (which is sufficient, because we assumed that the exceptional locus is empty).
  apply set.mem_image_of_mem,
  rw [exceptional_empty, set.diff_empty],
  -- Now we are ready to prove that p' = (c, m_x) lies on the upper branch.
  -- We need to check two conditions: H(c, m_x) and c < m_x.
  split; dsimp only,
  { -- The first condition is not so hard. After all, c is the other root of the quadratic equation.
    rw [H_symm, H_quad],
    simpa using h_root, },
  { -- For the second condition, we note that it suffices to check that c ≠ m_x.
    suffices hc : c ≠ mx,
    { refine lt_of_le_of_ne _ hc,
      exact_mod_cast c_lt, },
    -- However, recall that B(m_x) ≠ m_x + m_y.
    -- If c = m_x, we can prove B(m_x) = m_x + m_y.
    contrapose! hm_B₂, subst c,
    simp [hV₁], }
    -- Hence p' = (c, m_x) lies on the upper branch, and we are done.
end

/--Question 6 of IMO1988. If a and b are two natural numbers
such that a*b+1 divides a^2 + b^2, show that their quotient is a perfect square.-/
lemma imo1988_q6 {a b : ℕ} (h : (a*b+1) ∣ a^2 + b^2) :
  ∃ d, d^2 = (a^2 + b^2)/(a*b + 1) :=
begin
  rcases h with ⟨k, hk⟩,
  rw [hk, nat.mul_div_cancel_left _ (nat.succ_pos (a*b))],
  simp only [sq] at hk,
  apply constant_descent_vieta_jumping a b hk (λ x, k * x) (λ x, x*x - k) (λ x y, false);
  clear hk a b,
  { -- We will now show that the fibers of the solution set are described by a quadratic equation.
    intros x y, dsimp only,
    rw [← int.coe_nat_inj', ← sub_eq_zero],
    apply eq_iff_eq_cancel_right.2,
    norm_cast,
    simp, ring, },
  { -- Show that the solution set is symmetric in a and b.
    intros x y, simp [add_comm (x*x), mul_comm x], },
  { -- Show that the claim is true if b = 0.
    suffices : ∀ a, a * a = k → ∃ d, d * d = k, by simpa,
    rintros x rfl, use x },
  { -- Show that the claim is true if a = b.
    intros x hx,
    suffices : k ≤ 1,
    { rw [nat.le_add_one_iff, nat.le_zero_iff] at this,
      rcases this with rfl|rfl,
      { use 0, simp },
      { use 1, simp } },
    contrapose! hx with k_lt_one,
    apply ne_of_lt,
    calc x*x + x*x = x*x * 2       : by rw mul_two
               ... ≤ x*x * k       : nat.mul_le_mul_left (x*x) k_lt_one
               ... < (x*x + 1) * k : by linarith },
  { -- Show the descent step.
    intros x y hx x_lt_y hxky h z h_root hV₁ hV₀,
    split,
    { dsimp [-sub_eq_add_neg] at *,
      have hpos : z*z + x*x > 0,
      { apply add_pos_of_nonneg_of_pos,
        { apply mul_self_nonneg },
        { apply mul_pos; exact_mod_cast hx }, },
      have hzx : z*z + x*x = (z * x + 1) * k,
      { rw [← sub_eq_zero, ← h_root],
        ring, },
      rw hzx at hpos,
      replace hpos : z * x + 1 > 0 := pos_of_mul_pos_right hpos (int.coe_zero_le k),
      replace hpos : z * x ≥ 0 := int.le_of_lt_add_one hpos,
      apply nonneg_of_mul_nonneg_right hpos (by exact_mod_cast hx), },
    { contrapose! hV₀ with x_lt_z,
      apply ne_of_gt,
      calc z * y > x*x     : by apply mul_lt_mul'; linarith
             ... ≥ x*x - k : sub_le_self _ (int.coe_zero_le k) }, },
  { -- There is no base case in this application of Vieta jumping.
    simp },
end

/-
The following example illustrates the use of constant descent Vieta jumping
in the presence of a non-trivial base case.
-/

example {a b : ℕ} (h : a*b ∣ a^2 + b^2 + 1) :
  3*a*b = a^2 + b^2 + 1 :=
begin
  rcases h with ⟨k, hk⟩,
  suffices : k = 3, { simp * at *, ring, },
  simp only [sq] at hk,
  apply constant_descent_vieta_jumping a b hk (λ x, k * x) (λ x, x*x + 1) (λ x y, x ≤ 1);
  clear hk a b,
  { -- We will now show that the fibers of the solution set are described by a quadratic equation.
    intros x y, dsimp only,
    rw [← int.coe_nat_inj', ← sub_eq_zero],
    apply eq_iff_eq_cancel_right.2,
    simp, ring, },
  { -- Show that the solution set is symmetric in a and b.
    cc },
  { -- Show that the claim is true if b = 0.
    simp },
  { -- Show that the claim is true if a = b.
    intros x hx,
    have x_sq_dvd : x*x ∣ x*x*k := dvd_mul_right (x*x) k,
    rw ← hx at x_sq_dvd,
    obtain ⟨y, hy⟩ : x * x ∣ 1 := by simpa only [nat.dvd_add_self_left, add_assoc] using x_sq_dvd,
    obtain ⟨rfl,rfl⟩ : x = 1 ∧ y = 1 := by simpa [nat.mul_eq_one_iff] using hy.symm,
    simpa using hx.symm, },
  { -- Show the descent step.
    intros x y x_lt_y hx h_base h z h_root hV₁ hV₀,
    split,
    { have zy_pos : z * y ≥ 0,
      { rw hV₀, exact_mod_cast (nat.zero_le _) },
      apply nonneg_of_mul_nonneg_right zy_pos,
      linarith },
    { contrapose! hV₀ with x_lt_z,
      apply ne_of_gt,
      push_neg at h_base,
      calc z * y > x * y       : by apply mul_lt_mul_of_pos_right; linarith
             ... ≥ x * (x + 1) : by apply mul_le_mul; linarith
             ... > x * x + 1   :
        begin
          rw [mul_add, mul_one],
          apply add_lt_add_left,
          assumption_mod_cast
        end, } },
  { -- Show the base case.
    intros x y h h_base,
    obtain rfl|rfl : x = 0 ∨ x = 1 := by rwa [nat.le_add_one_iff, nat.le_zero_iff] at h_base,
    { simpa using h, },
    { simp only [mul_one, one_mul, add_comm, zero_add] at h,
      have y_dvd : y ∣ y * k := dvd_mul_right y k,
      rw [← h, ← add_assoc, nat.dvd_add_left (dvd_mul_left y y)] at y_dvd,
      obtain rfl|rfl : y = 1 ∨ y = 2 := nat.prime_two.2 y y_dvd,
      all_goals { ring_nf at h, omega } } }
end


/-
Copyright (c) 2021 Shing Tak Lam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/
import linear_algebra.matrix.to_lin
import linear_algebra.matrix.nonsingular_inverse

/-!
# The Unitary Group

This file defines elements of the unitary group `unitary_group n α`, where `α` is a `star_ring`.
This consists of all `n` by `n` matrices with entries in `α` such that the star-transpose is its
inverse. In addition, we define the group structure on `unitary_group n α`, and the embedding into
the general linear group `general_linear_group α (n → α)`.

We also define the orthogonal group `orthogonal_group n β`, where `β` is a `comm_ring`.

## Main Definitions

 * `matrix.unitary_group` is the type of matrices where the star-transpose is the inverse
 * `matrix.unitary_group.group` is the group structure (under multiplication)
 * `matrix.unitary_group.embedding_GL` is the embedding `unitary_group n α → GLₙ(α)`
 * `matrix.orthogonal_group` is the type of matrices where the transpose is the inverse

## References

 * https://en.wikipedia.org/wiki/Unitary_group

## Tags

matrix group, group, unitary group, orthogonal group

-/

universes u v

section

variables (M : Type v) [monoid M] [star_monoid M]

/--
In a `star_monoid M`, `unitary_submonoid M` is the submonoid consisting of all the elements of
`M` such that `star A * A = 1`.
-/
def unitary_submonoid : submonoid M :=
{ carrier := {A | star A * A = 1},
  one_mem' := by simp,
  mul_mem' := λ A B (hA : star A * A = 1) (hB : star B * B = 1), show star (A * B) * (A * B) = 1,
  by rwa [star_mul, ←mul_assoc, mul_assoc _ _ A, hA, mul_one] }

end

namespace matrix
open linear_map
open_locale matrix

section

variables (n : Type u) [decidable_eq n] [fintype n]
variables (α : Type v) [comm_ring α] [star_ring α]

/--
`unitary_group n` is the group of `n` by `n` matrices where the star-transpose is the inverse.
-/
@[derive monoid]
def unitary_group : Type* := unitary_submonoid (matrix n n α)

end

variables {n : Type u} [decidable_eq n] [fintype n]
variables {α : Type v} [comm_ring α] [star_ring α]

namespace unitary_submonoid

lemma star_mem {A : matrix n n α} (h : A ∈ unitary_submonoid (matrix n n α)) :
  star A ∈ unitary_submonoid (matrix n n α) :=
mul_eq_one_comm.mp $ (star_star A).symm ▸ h

@[simp]
lemma star_mem_iff {A : matrix n n α} :
  star A ∈ unitary_submonoid (matrix n n α) ↔ A ∈ unitary_submonoid (matrix n n α) :=
⟨λ ha, star_star A ▸ star_mem ha, star_mem⟩

end unitary_submonoid

namespace unitary_group

instance coe_matrix : has_coe (unitary_group n α) (matrix n n α) := ⟨subtype.val⟩

instance coe_fun : has_coe_to_fun (unitary_group n α) (λ _, n → n → α) :=
{ coe := λ A, A.val }

/--
`to_lin' A` is matrix multiplication of vectors by `A`, as a linear map.

After the group structure on `unitary_group n` is defined,
we show in `to_linear_equiv` that this gives a linear equivalence.
-/
def to_lin' (A : unitary_group n α) := matrix.to_lin' A

lemma ext_iff (A B : unitary_group n α) : A = B ↔ ∀ i j, A i j = B i j :=
subtype.ext_iff_val.trans ⟨(λ h i j, congr_fun (congr_fun h i) j), matrix.ext⟩

@[ext] lemma ext (A B : unitary_group n α) : (∀ i j, A i j = B i j) → A = B :=
(unitary_group.ext_iff A B).mpr

instance : has_inv (unitary_group n α) :=
⟨λ A, ⟨star A.1, unitary_submonoid.star_mem_iff.mpr A.2⟩⟩

instance : star_monoid (unitary_group n α) :=
{ star := λ A, ⟨star A.1, unitary_submonoid.star_mem A.2⟩,
  star_involutive := λ A, subtype.ext $ star_star A.1,
  star_mul := λ A B, subtype.ext $ star_mul A.1 B.1 }

@[simp]

instance : inhabited (unitary_group n α) := ⟨1⟩

section coe_lemmas

variables (A B : unitary_group n α)

@[simp] lemma inv_val : ↑(A⁻¹) = (star A : matrix n n α) := rfl

@[simp] lemma inv_apply : ⇑(A⁻¹) = (star A : matrix n n α) := rfl

@[simp] lemma mul_val : ↑(A * B) = A ⬝ B := rfl

@[simp] lemma mul_apply : ⇑(A * B) = (A ⬝ B) := rfl

@[simp] lemma one_val : ↑(1 : unitary_group n α) = (1 : matrix n n α) := rfl

@[simp] lemma one_apply : ⇑(1 : unitary_group n α) = (1 : matrix n n α) := rfl

@[simp] lemma to_lin'_mul :
  to_lin' (A * B) = (to_lin' A).comp (to_lin' B) :=
matrix.to_lin'_mul A B

@[simp] lemma to_lin'_one :
  to_lin' (1 : unitary_group n α) = linear_map.id :=
matrix.to_lin'_one

end coe_lemmas

instance : group (unitary_group n α) :=
{ mul_left_inv := λ A, subtype.eq A.2,
  ..unitary_group.has_inv,
  ..unitary_group.monoid n α }

/-- `to_linear_equiv A` is matrix multiplication of vectors by `A`, as a linear equivalence. -/
def to_linear_equiv (A : unitary_group n α) : (n → α) ≃ₗ[α] (n → α) :=
{ inv_fun := A⁻¹.to_lin',
  left_inv := λ x, calc
    A⁻¹.to_lin'.comp A.to_lin' x
        = (A⁻¹ * A).to_lin' x : by rw [←to_lin'_mul]
    ... = x : by rw [mul_left_inv, to_lin'_one, id_apply],
  right_inv := λ x, calc
    A.to_lin'.comp A⁻¹.to_lin' x
        = (A * A⁻¹).to_lin' x : by rw [←to_lin'_mul]
    ... = x : by rw [mul_right_inv, to_lin'_one, id_apply],
  ..matrix.to_lin' A }

/-- `to_GL` is the map from the unitary group to the general linear group -/
def to_GL (A : unitary_group n α) : general_linear_group α (n → α) :=
general_linear_group.of_linear_equiv (to_linear_equiv A)

lemma coe_to_GL (A : unitary_group n α) :
  ↑(to_GL A) = A.to_lin' :=
rfl

@[simp]
lemma to_GL_one : to_GL (1 : unitary_group n α) = 1 :=
by { ext1 v i, rw [coe_to_GL, to_lin'_one], refl }

@[simp]
lemma to_GL_mul (A B : unitary_group n α) :
  to_GL (A * B) = to_GL A * to_GL B :=
by { ext1 v i, rw [coe_to_GL, to_lin'_mul], refl }

/-- `unitary_group.embedding_GL` is the embedding from `unitary_group n α`
to `general_linear_group n α`. -/
def embedding_GL : unitary_group n α →* general_linear_group α (n → α) :=
⟨λ A, to_GL A, by simp, by simp⟩

end unitary_group

section orthogonal_group

variables (β : Type v) [comm_ring β]

local attribute [instance] star_ring_of_comm
/--
`orthogonal_group n` is the group of `n` by `n` matrices where the transpose is the inverse.
-/
abbreviation orthogonal_group := unitary_group n β

end orthogonal_group

end matrix


/-
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.continuants_recurrence
import algebra.continued_fractions.terminated_stable
import tactic.linarith
import tactic.field_simp

/-!
# Equivalence of Recursive and Direct Computations of `gcf` Convergents

## Summary

We show the equivalence of two computations of convergents (recurrence relation (`convergents`) vs.
direct evaluation (`convergents'`)) for `gcf`s on linear ordered fields. We follow the proof from
[hardy2008introduction], Chapter 10. Here's a sketch:

Let `c` be a continued fraction `[h; (a₀, b₀), (a₁, b₁), (a₂, b₂),...]`, visually:
                                a₀
                h + ---------------------------
                                  a₁
                      b₀ + --------------------
                                    a₂
                            b₁ + --------------
                                        a₃
                                  b₂ + --------
                                      b₃ + ...

One can compute the convergents of `c` in two ways:
1. Directly evaluating the fraction described by `c` up to a given `n` (`convergents'`)
2. Using the recurrence (`convergents`):
  - `A₋₁ = 1,  A₀ = h,  Aₙ = bₙ₋₁ * Aₙ₋₁ + aₙ₋₁ * Aₙ₋₂`, and
  - `B₋₁ = 0,  B₀ = 1,  Bₙ = bₙ₋₁ * Bₙ₋₁ + aₙ₋₁ * Bₙ₋₂`.

To show the equivalence of the computations in the main theorem of this file
`convergents_eq_convergents'`, we proceed by induction. The case `n = 0` is trivial.

For `n + 1`, we first "squash" the `n + 1`th position of `c` into the `n`th position to obtain
another continued fraction
  `c' := [h; (a₀, b₀),..., (aₙ-₁, bₙ-₁), (aₙ, bₙ + aₙ₊₁ / bₙ₊₁), (aₙ₊₁, bₙ₊₁),...]`.
This squashing process is formalised in section `squash`. Note that directly evaluating `c` up to
position `n + 1` is equal to evaluating `c'` up to `n`. This is shown in lemma
`succ_nth_convergent'_eq_squash_gcf_nth_convergent'`.

By the inductive hypothesis, the two computations for the `n`th convergent of `c` coincide.
So all that is left to show is that the recurrence relation for `c` at `n + 1` and and `c'` at
`n` coincide. This can be shown by another induction.
The corresponding lemma in this file is `succ_nth_convergent_eq_squash_gcf_nth_convergent`.

## Main Theorems

- `generalized_continued_fraction.convergents_eq_convergents'` shows the equivalence under a strict
positivity restriction on the sequence.
- `continued_fractions.convergents_eq_convergents'` shows the equivalence for (regular) continued
fractions.

## References

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

## Tags

fractions, recurrence, equivalence
-/

variables {K : Type*} {n : ℕ}
namespace generalized_continued_fraction
open generalized_continued_fraction as gcf
variables {g : gcf K} {s : seq $ gcf.pair K}

section squash
/-!
We will show the equivalence of the computations by induction. To make the induction work, we need
to be able to *squash* the nth and (n + 1)th value of a sequence. This squashing itself and the
lemmas about it are not very interesting. As a reader, you hence might want to skip this section.
-/

section with_division_ring
variable [division_ring K]

/--
Given a sequence of gcf.pairs `s = [(a₀, bₒ), (a₁, b₁), ...]`, `squash_seq s n`
combines `⟨aₙ, bₙ⟩` and `⟨aₙ₊₁, bₙ₊₁⟩` at position `n` to `⟨aₙ, bₙ + aₙ₊₁ / bₙ₊₁⟩`. For example,
`squash_seq s 0 = [(a₀, bₒ + a₁ / b₁), (a₁, b₁),...]`.
If `s.terminated_at (n + 1)`, then `squash_seq s n = s`.
-/
def squash_seq (s : seq $ gcf.pair K) (n : ℕ) : seq (gcf.pair K) :=
match prod.mk (s.nth n) (s.nth (n + 1)) with
| ⟨some gp_n, some gp_succ_n⟩ := seq.nats.zip_with
    -- return the squashed value at position `n`; otherwise, do nothing.
    (λ n' gp, if n' = n then ⟨gp_n.a, gp_n.b + gp_succ_n.a / gp_succ_n.b⟩ else gp) s
| _ := s
end

/-! We now prove some simple lemmas about the squashed sequence -/

/-- If the sequence already terminated at position `n + 1`, nothing gets squashed. -/
lemma squash_seq_eq_self_of_terminated (terminated_at_succ_n : s.terminated_at (n + 1)) :
  squash_seq s n = s :=
begin
  change s.nth (n + 1) = none at terminated_at_succ_n,
  cases s_nth_eq : (s.nth n);
  simp only [*, squash_seq]
end

/-- If the sequence has not terminated before position `n + 1`, the value at `n + 1` gets
squashed into position `n`. -/
lemma squash_seq_nth_of_not_terminated {gp_n gp_succ_n : gcf.pair K}
  (s_nth_eq : s.nth n = some gp_n) (s_succ_nth_eq : s.nth (n + 1) = some gp_succ_n) :
  (squash_seq s n).nth n = some ⟨gp_n.a, gp_n.b + gp_succ_n.a / gp_succ_n.b⟩ :=
by simp [*, squash_seq, (seq.zip_with_nth_some (seq.nats_nth n) s_nth_eq _)]

/-- The values before the squashed position stay the same. -/
lemma squash_seq_nth_of_lt {m : ℕ} (m_lt_n : m < n) : (squash_seq s n).nth m = s.nth m :=
begin
  cases s_succ_nth_eq : s.nth (n + 1),
  case option.none { rw (squash_seq_eq_self_of_terminated s_succ_nth_eq) },
  case option.some
  { obtain ⟨gp_n, s_nth_eq⟩ : ∃ gp_n, s.nth n = some gp_n, from
      s.ge_stable n.le_succ s_succ_nth_eq,
    obtain ⟨gp_m, s_mth_eq⟩ : ∃ gp_m, s.nth m = some gp_m, from
      s.ge_stable (le_of_lt m_lt_n) s_nth_eq,
    simp [*, squash_seq, (seq.zip_with_nth_some (seq.nats_nth m) s_mth_eq _),
      (ne_of_lt m_lt_n)] }
end

/-- Squashing at position `n + 1` and taking the tail is the same as squashing the tail of the
sequence at position `n`. -/
lemma squash_seq_succ_n_tail_eq_squash_seq_tail_n :
  (squash_seq s (n + 1)).tail = squash_seq s.tail n :=
begin
  cases s_succ_succ_nth_eq : s.nth (n + 2) with gp_succ_succ_n,
  case option.none
  { have : squash_seq s (n + 1) = s, from squash_seq_eq_self_of_terminated s_succ_succ_nth_eq,
    cases s_succ_nth_eq : (s.nth (n + 1));
    simp only [squash_seq, seq.nth_tail, s_succ_nth_eq, s_succ_succ_nth_eq] },
  case option.some
  { obtain ⟨gp_succ_n, s_succ_nth_eq⟩ : ∃ gp_succ_n, s.nth (n + 1) = some gp_succ_n, from
      s.ge_stable (n + 1).le_succ s_succ_succ_nth_eq,
    -- apply extensionality with `m` and continue by cases `m = n`.
    ext m,
    cases decidable.em (m = n) with m_eq_n m_ne_n,
    { have : s.tail.nth n = some gp_succ_n, from (s.nth_tail n).trans s_succ_nth_eq,
      simp [*, squash_seq, seq.nth_tail, (seq.zip_with_nth_some (seq.nats_nth n) this),
        (seq.zip_with_nth_some (seq.nats_nth (n + 1)) s_succ_nth_eq)] },
    { have : s.tail.nth m = s.nth (m + 1), from s.nth_tail m,
      cases s_succ_mth_eq : s.nth (m + 1),
      all_goals { have s_tail_mth_eq, from this.trans s_succ_mth_eq },
      { simp only [*, squash_seq, seq.nth_tail, (seq.zip_with_nth_none' s_succ_mth_eq),
          (seq.zip_with_nth_none' s_tail_mth_eq)] },
      { simp [*, squash_seq, seq.nth_tail,
          (seq.zip_with_nth_some (seq.nats_nth (m + 1)) s_succ_mth_eq),
          (seq.zip_with_nth_some (seq.nats_nth m) s_tail_mth_eq)] } } }
end

/-- The auxiliary function `convergents'_aux` returns the same value for a sequence and the
corresponding squashed sequence at the squashed position. -/
lemma succ_succ_nth_convergent'_aux_eq_succ_nth_convergent'_aux_squash_seq :
  convergents'_aux s (n + 2) = convergents'_aux (squash_seq s n) (n + 1) :=
begin
  cases s_succ_nth_eq : (s.nth $ n + 1) with gp_succ_n,
  case option.none
  { rw [(squash_seq_eq_self_of_terminated s_succ_nth_eq),
        (convergents'_aux_stable_step_of_terminated s_succ_nth_eq)] },
  case option.some
  { induction n with m IH generalizing s gp_succ_n,
    case nat.zero
    { obtain ⟨gp_head, s_head_eq⟩ : ∃ gp_head, s.head = some gp_head, from
        s.ge_stable zero_le_one s_succ_nth_eq,
      have : (squash_seq s 0).head = some ⟨gp_head.a, gp_head.b + gp_succ_n.a / gp_succ_n.b⟩,
        from squash_seq_nth_of_not_terminated s_head_eq s_succ_nth_eq,
      simp [*, convergents'_aux, seq.head, seq.nth_tail] },
    case nat.succ
    { obtain ⟨gp_head, s_head_eq⟩ : ∃ gp_head, s.head = some gp_head, from
        s.ge_stable (m + 2).zero_le s_succ_nth_eq,
      suffices : gp_head.a / (gp_head.b + convergents'_aux s.tail (m + 2))
               = convergents'_aux (squash_seq s (m + 1)) (m + 2), by
        simpa only [convergents'_aux, s_head_eq],
      have : convergents'_aux s.tail (m + 2) = convergents'_aux (squash_seq s.tail m) (m + 1), by
      { have : s.tail.nth (m + 1) = some gp_succ_n, by simpa [seq.nth_tail] using s_succ_nth_eq,
        exact (IH _ this) },
      have : (squash_seq s (m + 1)).head = some gp_head, from
        (squash_seq_nth_of_lt m.succ_pos).trans s_head_eq,
      simp only [*, convergents'_aux, squash_seq_succ_n_tail_eq_squash_seq_tail_n] } }
end

/-! Let us now lift the squashing operation to gcfs. -/

/--
Given a gcf `g = [h; (a₀, bₒ), (a₁, b₁), ...]`, we have
- `squash_nth.gcf g 0 = [h + a₀ / b₀); (a₀, bₒ), ...]`,
- `squash_nth.gcf g (n + 1) = ⟨g.h, squash_seq g.s n⟩`
-/
def squash_gcf (g : gcf K) : ℕ → gcf K
| 0 := match g.s.nth 0 with
  | none := g
  | some gp := ⟨g.h + gp.a / gp.b, g.s⟩
  end
| (n + 1) := ⟨g.h, squash_seq g.s n⟩

/-! Again, we derive some simple lemmas that are not really of interest. This time for the
squashed gcf. -/

/-- If the gcf already terminated at position `n`, nothing gets squashed. -/
lemma squash_gcf_eq_self_of_terminated (terminated_at_n : terminated_at g n) :
  squash_gcf g n = g :=
begin
  cases n,
  case nat.zero
  { change g.s.nth 0 = none at terminated_at_n,
    simp only [convergents', squash_gcf, convergents'_aux, terminated_at_n] },
  case nat.succ
  { cases g, simp [(squash_seq_eq_self_of_terminated terminated_at_n), squash_gcf] }
end

/-- The values before the squashed position stay the same. -/
lemma squash_gcf_nth_of_lt {m : ℕ} (m_lt_n : m < n) :
  (squash_gcf g (n + 1)).s.nth m = g.s.nth m :=
by simp only [squash_gcf, (squash_seq_nth_of_lt m_lt_n)]

/-- `convergents'` returns the same value for a gcf and the corresponding squashed gcf at the
squashed position. -/
lemma succ_nth_convergent'_eq_squash_gcf_nth_convergent' :
  g.convergents' (n + 1) = (squash_gcf g n).convergents' n :=
begin
  cases n,
  case nat.zero
  { cases g_s_head_eq : (g.s.nth 0);
    simp [g_s_head_eq, squash_gcf, convergents', convergents'_aux, seq.head] },
  case nat.succ
  { simp only [succ_succ_nth_convergent'_aux_eq_succ_nth_convergent'_aux_squash_seq,
      convergents', squash_gcf] }
end

/-- The auxiliary continuants before the squashed position stay the same. -/
lemma continuants_aux_eq_continuants_aux_squash_gcf_of_le {m : ℕ} :
  m ≤ n → continuants_aux g m = (squash_gcf g n).continuants_aux m :=
nat.strong_induction_on m
(begin
  clear m,
  assume m IH m_le_n,
  cases m with m',
  { refl },
  { cases n with n',
    { have : false, from m'.not_succ_le_zero m_le_n, contradiction }, -- 1 ≰ 0
    { cases m' with m'',
      { refl },
      { -- get some inequalities to instantiate the IH for m'' and m'' + 1
        have m'_lt_n : m'' + 1 < n' + 1, from m_le_n,
        have : m'' + 1 < m'' + 2, by linarith,
        have succ_m''th_conts_aux_eq := IH (m'' + 1) this (le_of_lt m'_lt_n),
        have : m'' < m'' + 2, by linarith,
        have m''th_conts_aux_eq := IH m'' this (le_of_lt $ lt_of_lt_of_le (by linarith) n'.le_succ),
        have : (squash_gcf g (n' + 1)).s.nth m'' = g.s.nth m'', from
          squash_gcf_nth_of_lt (by linarith),
        simp [continuants_aux, succ_m''th_conts_aux_eq, m''th_conts_aux_eq, this] } } }
end)

end with_division_ring

/-- The convergents coincide in the expected way at the squashed position if the partial denominator
at the squashed position is not zero. -/
lemma succ_nth_convergent_eq_squash_gcf_nth_convergent [field K]
  (nth_part_denom_ne_zero : ∀ {b : K}, g.partial_denominators.nth n = some b → b ≠ 0) :
  g.convergents (n + 1) = (squash_gcf g n).convergents n :=
begin
  cases decidable.em (g.terminated_at n) with terminated_at_n not_terminated_at_n,
  { have : squash_gcf g n = g, from squash_gcf_eq_self_of_terminated terminated_at_n,
    simp only [this, (convergents_stable_of_terminated n.le_succ terminated_at_n)] },
  { obtain ⟨⟨a, b⟩, s_nth_eq⟩ : ∃ gp_n, g.s.nth n = some gp_n, from
      option.ne_none_iff_exists'.mp not_terminated_at_n,
    have b_ne_zero : b ≠ 0, from nth_part_denom_ne_zero (part_denom_eq_s_b s_nth_eq),
    cases n with n',
    case nat.zero
    { suffices : (b * g.h + a) / b = g.h + a / b, by
        simpa [squash_gcf, s_nth_eq, convergent_eq_conts_a_div_conts_b,
          (continuants_recurrence_aux s_nth_eq zeroth_continuant_aux_eq_one_zero
          first_continuant_aux_eq_h_one)],
      calc
        (b * g.h + a) / b = b * g.h / b + a / b  : by ring -- requires `field`, not `division_ring`
                      ... = g.h + a / b          : by rw (mul_div_cancel_left _ b_ne_zero) },
    case nat.succ
    { obtain ⟨⟨pa, pb⟩, s_n'th_eq⟩ : ∃ gp_n', g.s.nth n' = some gp_n' :=
        g.s.ge_stable n'.le_succ s_nth_eq,
      -- Notations
      let g' := squash_gcf g (n' + 1),
      set pred_conts := g.continuants_aux (n' + 1) with succ_n'th_conts_aux_eq,
      set ppred_conts := g.continuants_aux n' with n'th_conts_aux_eq,
      let pA := pred_conts.a, let pB := pred_conts.b,
      let ppA := ppred_conts.a, let ppB := ppred_conts.b,
      set pred_conts' := g'.continuants_aux (n' + 1) with succ_n'th_conts_aux_eq',
      set ppred_conts' := g'.continuants_aux n' with n'th_conts_aux_eq',
      let pA' := pred_conts'.a, let pB' := pred_conts'.b, let ppA' := ppred_conts'.a,
      let ppB' := ppred_conts'.b,
      -- first compute the convergent of the squashed gcf
      have : g'.convergents (n' + 1)
           = ((pb + a / b) * pA' + pa * ppA') / ((pb + a / b) * pB' + pa * ppB'),
      { have : g'.s.nth n' = some ⟨pa, pb + a / b⟩ :=
          squash_seq_nth_of_not_terminated s_n'th_eq s_nth_eq,
        rw [convergent_eq_conts_a_div_conts_b,
          continuants_recurrence_aux this n'th_conts_aux_eq'.symm succ_n'th_conts_aux_eq'.symm], },
      rw this,
      -- then compute the convergent of the original gcf by recursively unfolding the continuants
      -- computation twice
      have : g.convergents (n' + 2)
           = (b * (pb * pA + pa * ppA) + a * pA) / (b * (pb * pB + pa * ppB) + a * pB),
      { -- use the recurrence once
        have : g.continuants_aux (n' + 2) = ⟨pb * pA + pa * ppA, pb * pB + pa * ppB⟩ :=
          continuants_aux_recurrence s_n'th_eq n'th_conts_aux_eq.symm succ_n'th_conts_aux_eq.symm,
        -- and a second time
        rw [convergent_eq_conts_a_div_conts_b,
          continuants_recurrence_aux s_nth_eq succ_n'th_conts_aux_eq.symm this] },
      rw this,
      suffices : ((pb + a / b) * pA + pa * ppA) / ((pb + a / b) * pB + pa * ppB)
               = (b * (pb * pA + pa * ppA) + a * pA) / (b * (pb * pB + pa * ppB) + a * pB),
      { obtain ⟨eq1, eq2, eq3, eq4⟩ : pA' = pA ∧ pB' = pB ∧ ppA' = ppA ∧ ppB' = ppB,
        { simp [*, (continuants_aux_eq_continuants_aux_squash_gcf_of_le $ le_refl $ n' + 1).symm,
            (continuants_aux_eq_continuants_aux_squash_gcf_of_le n'.le_succ).symm] },
        symmetry,
        simpa only [eq1, eq2, eq3, eq4, mul_div_cancel _  b_ne_zero] },
      field_simp,
      congr' 1; ring } }
end

end squash

/-- Shows that the recurrence relation (`convergents`) and direct evaluation (`convergents'`) of the
gcf coincide at position `n` if the sequence of fractions contains strictly positive values only.
Requiring positivity of all values is just one possible condition to obtain this result.
For example, the dual - sequences with strictly negative values only - would also work.

In practice, one most commonly deals with (regular) continued fractions, which satisfy the
positivity criterion required here. The analogous result for them
(see `continued_fractions.convergents_eq_convergents`) hence follows directly from this theorem.
-/
theorem convergents_eq_convergents' [linear_ordered_field K]
  (s_pos : ∀ {gp : gcf.pair K} {m : ℕ}, m < n → g.s.nth m = some gp → 0 < gp.a ∧ 0 < gp.b) :
  g.convergents n = g.convergents' n :=
begin
  induction n with n IH generalizing g,
  case nat.zero { simp },
  case nat.succ
  { let g' := squash_gcf g n, -- first replace the rhs with the squashed computation
    suffices : g.convergents (n + 1) = g'.convergents' n, by
      rwa [succ_nth_convergent'_eq_squash_gcf_nth_convergent'],
    cases decidable.em (terminated_at g n) with terminated_at_n not_terminated_at_n,
    { have g'_eq_g : g' = g, from squash_gcf_eq_self_of_terminated terminated_at_n,
      have : ∀ ⦃gp m⦄, m < n → g.s.nth m = some gp → 0 < gp.a ∧ 0 < gp.b, by
        { assume _ _ m_lt_n s_mth_eq, exact (s_pos (nat.lt.step m_lt_n) s_mth_eq) },
      rw [(convergents_stable_of_terminated n.le_succ terminated_at_n), g'_eq_g, (IH this)] },
    { suffices : g.convergents (n + 1) = g'.convergents n, by -- invoke the IH for the squashed gcf
      { have : ∀ ⦃gp' m⦄, m < n → g'.s.nth m = some gp' → 0 < gp'.a ∧ 0 < gp'.b, by
        { assume gp' m m_lt_n s_mth_eq',
          -- case distinction on m + 1 = n or m + 1 < n
          cases m_lt_n with n succ_m_lt_n,
          { -- the difficult case at the squashed position: we first obtain the values from
            -- the sequence
            obtain ⟨gp_succ_m, s_succ_mth_eq⟩ : ∃ gp_succ_m, g.s.nth (m + 1) = some gp_succ_m, from
              option.ne_none_iff_exists'.mp not_terminated_at_n,
            obtain ⟨gp_m, mth_s_eq⟩ : ∃ gp_m, g.s.nth m = some gp_m, from
              g.s.ge_stable m.le_succ s_succ_mth_eq,
            -- we then plug them into the recurrence
            suffices : 0 < gp_m.a ∧ 0 < gp_m.b + gp_succ_m.a / gp_succ_m.b, by {
              have : g'.s.nth m = some ⟨gp_m.a, gp_m.b + gp_succ_m.a / gp_succ_m.b⟩, from
                squash_seq_nth_of_not_terminated mth_s_eq s_succ_mth_eq,
              have : gp' = ⟨gp_m.a, gp_m.b + gp_succ_m.a / gp_succ_m.b⟩, by cc,
              rwa this },
            split,
            { exact (s_pos (nat.lt.step m_lt_n) mth_s_eq).left },
            { have : 0 < gp_m.b, from (s_pos (nat.lt.step m_lt_n) mth_s_eq).right,
              have : 0 < gp_succ_m.a / gp_succ_m.b, by
              { have : 0 < gp_succ_m.a ∧ 0 < gp_succ_m.b, from
                  s_pos (lt_add_one $ m + 1) s_succ_mth_eq,
                exact (div_pos this.left this.right) },
              linarith } },
          { -- the easy case: before the squashed position, nothing changes
            have : g.s.nth m = some gp', by {
              have : g'.s.nth m = g.s.nth m, from squash_gcf_nth_of_lt succ_m_lt_n,
              rwa this at s_mth_eq' },
            exact s_pos (nat.lt.step $ nat.lt.step succ_m_lt_n) this } },
        rwa [(IH this).symm] },
      -- now the result follows from the fact that the convergents coincide at the squashed position
      -- as established in `succ_nth_convergent_eq_squash_gcf_nth_convergent`.
      have : ∀ ⦃b⦄, g.partial_denominators.nth n = some b → b ≠ 0, by
      { assume b nth_part_denom_eq,
        obtain ⟨gp, s_nth_eq, ⟨refl⟩⟩ : ∃ gp, g.s.nth n = some gp ∧ gp.b = b, from
          exists_s_b_of_part_denom nth_part_denom_eq,
        exact (ne_of_lt (s_pos (lt_add_one n) s_nth_eq).right).symm },
      exact succ_nth_convergent_eq_squash_gcf_nth_convergent this } }
end

end generalized_continued_fraction

namespace continued_fraction
open generalized_continued_fraction as gcf
open simple_continued_fraction as scf
open continued_fraction as cf

/-- Shows that the recurrence relation (`convergents`) and direct evaluation (`convergents'`) of a
(regular) continued fraction coincide. -/
theorem convergents_eq_convergents' [linear_ordered_field K] {c : cf K} :
  (↑c : gcf K).convergents = (↑c : gcf K).convergents' :=
begin
  ext n,
  apply gcf.convergents_eq_convergents',
  assume gp m m_lt_n s_nth_eq,
  split,
  { have : gp.a = 1, from (c : scf K).property m gp.a (gcf.part_num_eq_s_a s_nth_eq),
    simp only [zero_lt_one, this] },
  { exact (c.property m gp.b $ gcf.part_denom_eq_s_b s_nth_eq) }
end

end continued_fraction