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

! This file was ported from Lean 3 source module algebra.continued_fractions.basic
! leanprover-community/mathlib commit a7e36e48519ab281320c4d192da6a7b348ce40ad
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Seq.Seq
import Mathbin.Algebra.Field.Defs

/-!
# Basic Definitions/Theorems for Continued Fractions

## Summary

We define generalised, simple, and regular continued fractions and functions to evaluate their
convergents. We follow the naming conventions from Wikipedia and [wall2018analytic], Chapter 1.

## Main definitions

1. Generalised continued fractions (gcfs)
2. Simple continued fractions (scfs)
3. (Regular) continued fractions ((r)cfs)
4. Computation of convergents using the recurrence relation in `convergents`.
5. Computation of convergents by directly evaluating the fraction described by the gcf in
`convergents'`.

## Implementation notes

1. The most commonly used kind of continued fractions in the literature are regular continued
fractions. We hence just call them `continued_fractions` in the library.
2. We use sequences from `data.seq` to encode potentially infinite sequences.

## References

- <https://en.wikipedia.org/wiki/Generalized_continued_fraction>
- [Wall, H.S., *Analytic Theory of Continued Fractions*][wall2018analytic]

## Tags

numerics, number theory, approximations, fractions
-/

-- Fix a carrier `α`.
variable (α : Type _)

/-!### Definitions-/

/-- We collect a partial numerator `aᵢ` and partial denominator `bᵢ` in a pair `⟨aᵢ,bᵢ⟩`. -/
protected structure GeneralizedContinuedFraction.Pair where
  a : α
  b : α
  deriving Inhabited
#align generalized_continued_fraction.pair GeneralizedContinuedFraction.Pair

open GeneralizedContinuedFraction

/- ./././Mathport/Syntax/Translate/Command.lean:224:11: unsupported: unusual advanced open style -/
/-! Interlude: define some expected coercions and instances. -/

namespace GeneralizedContinuedFraction.Pair

variable {α}

/-- Make a `gcf.pair` printable. -/
instance [Repr α] : Repr (Pair α) :=
  ⟨fun p => "(a : " ++ repr p.a ++ ", b : " ++ repr p.b ++ ")"⟩

/-- Maps a function `f` on both components of a given pair. -/
def map {β : Type _} (f : α → β) (gp : Pair α) : Pair β :=
  ⟨f gp.a, f gp.b⟩
#align generalized_continued_fraction.pair.map GeneralizedContinuedFraction.Pair.map

section coe

-- Fix another type `β` which we will convert to.
variable {β : Type _} [Coe α β]

/-- Coerce a pair by elementwise coercion. -/
instance hasCoeToGeneralizedContinuedFractionPair : Coe (Pair α) (Pair β) :=
  ⟨map coe⟩
#align generalized_continued_fraction.pair.has_coe_to_generalized_continued_fraction_pair GeneralizedContinuedFraction.Pair.hasCoeToGeneralizedContinuedFractionPair

@[simp, norm_cast]
theorem coe_to_generalized_continued_fraction_pair {a b : α} :
    (↑(Pair.mk a b) : Pair β) = Pair.mk (a : β) (b : β) :=
  rfl
#align generalized_continued_fraction.pair.coe_to_generalized_continued_fraction_pair GeneralizedContinuedFraction.Pair.coe_to_generalized_continued_fraction_pair

end coe

end GeneralizedContinuedFraction.Pair

variable (α)

/-- A *generalised continued fraction* (gcf) is a potentially infinite expression of the form
$$
  h + \dfrac{a_0}
            {b_0 + \dfrac{a_1}
                         {b_1 + \dfrac{a_2}
                                      {b_2 + \dfrac{a_3}
                                                   {b_3 + \dots}}}}
$$
where `h` is called the *head term* or *integer part*, the `aᵢ` are called the
*partial numerators* and the `bᵢ` the *partial denominators* of the gcf.
We store the sequence of partial numerators and denominators in a sequence of
generalized_continued_fraction.pairs `s`.
For convenience, one often writes `[h; (a₀, b₀), (a₁, b₁), (a₂, b₂),...]`.
-/
structure GeneralizedContinuedFraction where
  h : α
  s : Seq <| Pair α
#align generalized_continued_fraction GeneralizedContinuedFraction

variable {α}

namespace GeneralizedContinuedFraction

/-- Constructs a generalized continued fraction without fractional part. -/
def ofInteger (a : α) : GeneralizedContinuedFraction α :=
  ⟨a, Seq.nil⟩
#align generalized_continued_fraction.of_integer GeneralizedContinuedFraction.ofInteger

instance [Inhabited α] : Inhabited (GeneralizedContinuedFraction α) :=
  ⟨ofInteger default⟩

/-- Returns the sequence of partial numerators `aᵢ` of `g`. -/
def partialNumerators (g : GeneralizedContinuedFraction α) : Seq α :=
  g.s.map Pair.a
#align generalized_continued_fraction.partial_numerators GeneralizedContinuedFraction.partialNumerators

/-- Returns the sequence of partial denominators `bᵢ` of `g`. -/
def partialDenominators (g : GeneralizedContinuedFraction α) : Seq α :=
  g.s.map Pair.b
#align generalized_continued_fraction.partial_denominators GeneralizedContinuedFraction.partialDenominators

/-- A gcf terminated at position `n` if its sequence terminates at position `n`. -/
def TerminatedAt (g : GeneralizedContinuedFraction α) (n : ℕ) : Prop :=
  g.s.TerminatedAt n
#align generalized_continued_fraction.terminated_at GeneralizedContinuedFraction.TerminatedAt

/-- It is decidable whether a gcf terminated at a given position. -/
instance terminatedAtDecidable (g : GeneralizedContinuedFraction α) (n : ℕ) :
    Decidable (g.TerminatedAt n) := by
  unfold terminated_at
  infer_instance
#align generalized_continued_fraction.terminated_at_decidable GeneralizedContinuedFraction.terminatedAtDecidable

/-- A gcf terminates if its sequence terminates. -/
def Terminates (g : GeneralizedContinuedFraction α) : Prop :=
  g.s.Terminates
#align generalized_continued_fraction.terminates GeneralizedContinuedFraction.Terminates

section coe

/-! Interlude: define some expected coercions. -/

-- Fix another type `β` which we will convert to.
variable {β : Type _} [Coe α β]

/-- Coerce a gcf by elementwise coercion. -/
instance hasCoeToGeneralizedContinuedFraction :
    Coe (GeneralizedContinuedFraction α) (GeneralizedContinuedFraction β) :=
  ⟨fun g => ⟨(g.h : β), (g.s.map coe : Seq <| Pair β)⟩⟩
#align generalized_continued_fraction.has_coe_to_generalized_continued_fraction GeneralizedContinuedFraction.hasCoeToGeneralizedContinuedFraction

@[simp, norm_cast]
theorem coe_to_generalizedContinuedFraction {g : GeneralizedContinuedFraction α} :
    (↑(g : GeneralizedContinuedFraction α) : GeneralizedContinuedFraction β) =
      ⟨(g.h : β), (g.s.map coe : Seq <| Pair β)⟩ :=
  rfl
#align generalized_continued_fraction.coe_to_generalized_continued_fraction GeneralizedContinuedFraction.coe_to_generalizedContinuedFraction

end coe

end GeneralizedContinuedFraction

/-- A generalized continued fraction is a *simple continued fraction* if all partial numerators are
equal to one.
$$
  h + \dfrac{1}
            {b_0 + \dfrac{1}
                         {b_1 + \dfrac{1}
                                      {b_2 + \dfrac{1}
                                                   {b_3 + \dots}}}}
$$
-/
def GeneralizedContinuedFraction.IsSimpleContinuedFraction (g : GeneralizedContinuedFraction α)
    [One α] : Prop :=
  ∀ (n : ℕ) (aₙ : α), g.partialNumerators.get? n = some aₙ → aₙ = 1
#align generalized_continued_fraction.is_simple_continued_fraction GeneralizedContinuedFraction.IsSimpleContinuedFraction

variable (α)

/-- A *simple continued fraction* (scf) is a generalized continued fraction (gcf) whose partial
numerators are equal to one.
$$
  h + \dfrac{1}
            {b_0 + \dfrac{1}
                         {b_1 + \dfrac{1}
                                      {b_2 + \dfrac{1}
                                                   {b_3 + \dots}}}}
$$
For convenience, one often writes `[h; b₀, b₁, b₂,...]`.
It is encoded as the subtype of gcfs that satisfy
`generalized_continued_fraction.is_simple_continued_fraction`.
 -/
def SimpleContinuedFraction [One α] :=
  { g : GeneralizedContinuedFraction α // g.IsSimpleContinuedFraction }
#align simple_continued_fraction SimpleContinuedFraction

variable {α}

-- Interlude: define some expected coercions.
namespace SimpleContinuedFraction

variable [One α]

/-- Constructs a simple continued fraction without fractional part. -/
def ofInteger (a : α) : SimpleContinuedFraction α :=
  ⟨GeneralizedContinuedFraction.ofInteger a, fun n aₙ h => by cases h⟩
#align simple_continued_fraction.of_integer SimpleContinuedFraction.ofInteger

instance : Inhabited (SimpleContinuedFraction α) :=
  ⟨ofInteger 1⟩

/-- Lift a scf to a gcf using the inclusion map. -/
instance hasCoeToGeneralizedContinuedFraction :
    Coe (SimpleContinuedFraction α) (GeneralizedContinuedFraction α) :=
  by
  unfold SimpleContinuedFraction
  infer_instance
#align simple_continued_fraction.has_coe_to_generalized_continued_fraction SimpleContinuedFraction.hasCoeToGeneralizedContinuedFraction

theorem coe_to_generalizedContinuedFraction {s : SimpleContinuedFraction α} :
    (↑s : GeneralizedContinuedFraction α) = s.val :=
  rfl
#align simple_continued_fraction.coe_to_generalized_continued_fraction SimpleContinuedFraction.coe_to_generalizedContinuedFraction

end SimpleContinuedFraction

/--
A simple continued fraction is a *(regular) continued fraction* ((r)cf) if all partial denominators
`bᵢ` are positive, i.e. `0 < bᵢ`.
-/
def SimpleContinuedFraction.IsContinuedFraction [One α] [Zero α] [LT α]
    (s : SimpleContinuedFraction α) : Prop :=
  ∀ (n : ℕ) (bₙ : α),
    (↑s : GeneralizedContinuedFraction α).partialDenominators.get? n = some bₙ → 0 < bₙ
#align simple_continued_fraction.is_continued_fraction SimpleContinuedFraction.IsContinuedFraction

variable (α)

/-- A *(regular) continued fraction* ((r)cf) is a simple continued fraction (scf) whose partial
denominators are all positive. It is the subtype of scfs that satisfy
`simple_continued_fraction.is_continued_fraction`.
 -/
def ContinuedFraction [One α] [Zero α] [LT α] :=
  { s : SimpleContinuedFraction α // s.IsContinuedFraction }
#align continued_fraction ContinuedFraction

variable {α}

/-! Interlude: define some expected coercions. -/

namespace ContinuedFraction

variable [One α] [Zero α] [LT α]

/-- Constructs a continued fraction without fractional part. -/
def ofInteger (a : α) : ContinuedFraction α :=
  ⟨SimpleContinuedFraction.ofInteger a, fun n bₙ h => by cases h⟩
#align continued_fraction.of_integer ContinuedFraction.ofInteger

instance : Inhabited (ContinuedFraction α) :=
  ⟨ofInteger 0⟩

/-- Lift a cf to a scf using the inclusion map. -/
instance hasCoeToSimpleContinuedFraction : Coe (ContinuedFraction α) (SimpleContinuedFraction α) :=
  by
  unfold ContinuedFraction
  infer_instance
#align continued_fraction.has_coe_to_simple_continued_fraction ContinuedFraction.hasCoeToSimpleContinuedFraction

theorem coe_to_simpleContinuedFraction {c : ContinuedFraction α} :
    (↑c : SimpleContinuedFraction α) = c.val :=
  rfl
#align continued_fraction.coe_to_simple_continued_fraction ContinuedFraction.coe_to_simpleContinuedFraction

/-- Lift a cf to a scf using the inclusion map. -/
instance hasCoeToGeneralizedContinuedFraction :
    Coe (ContinuedFraction α) (GeneralizedContinuedFraction α) :=
  ⟨fun c => ↑(↑c : SimpleContinuedFraction α)⟩
#align continued_fraction.has_coe_to_generalized_continued_fraction ContinuedFraction.hasCoeToGeneralizedContinuedFraction

theorem coe_to_generalizedContinuedFraction {c : ContinuedFraction α} :
    (↑c : GeneralizedContinuedFraction α) = c.val :=
  rfl
#align continued_fraction.coe_to_generalized_continued_fraction ContinuedFraction.coe_to_generalizedContinuedFraction

end ContinuedFraction

namespace GeneralizedContinuedFraction

/-!
### Computation of Convergents

We now define how to compute the convergents of a gcf. There are two standard ways to do this:
directly evaluating the (infinite) fraction described by the gcf or using a recurrence relation.
For (r)cfs, these computations are equivalent as shown in
`algebra.continued_fractions.convergents_equiv`.
-/

-- Fix a division ring for the computations.
variable {K : Type _} [DivisionRing K]

/-!
We start with the definition of the recurrence relation. Given a gcf `g`, for all `n ≥ 1`, we define
- `A₋₁ = 1,  A₀ = h,  Aₙ = bₙ₋₁ * Aₙ₋₁ + aₙ₋₁ * Aₙ₋₂`, and
- `B₋₁ = 0,  B₀ = 1,  Bₙ = bₙ₋₁ * Bₙ₋₁ + aₙ₋₁ * Bₙ₋₂`.

`Aₙ, `Bₙ` are called the *nth continuants*, Aₙ the *nth numerator*, and `Bₙ` the
*nth denominator* of `g`. The *nth convergent* of `g` is given by `Aₙ / Bₙ`.
-/

/-- Returns the next numerator `Aₙ = bₙ₋₁ * Aₙ₋₁ + aₙ₋₁ * Aₙ₋₂`, where `predA` is `Aₙ₋₁`,
`ppredA` is `Aₙ₋₂`, `a` is `aₙ₋₁`, and `b` is `bₙ₋₁`.
-/
def nextNumerator (a b ppredA predA : K) : K :=
  b * predA + a * ppredA
#align generalized_continued_fraction.next_numerator GeneralizedContinuedFraction.nextNumerator

/-- Returns the next denominator `Bₙ = bₙ₋₁ * Bₙ₋₁ + aₙ₋₁ * Bₙ₋₂``, where `predB` is `Bₙ₋₁` and
`ppredB` is `Bₙ₋₂`, `a` is `aₙ₋₁`, and `b` is `bₙ₋₁`.
-/
def nextDenominator (aₙ bₙ ppredB predB : K) : K :=
  bₙ * predB + aₙ * ppredB
#align generalized_continued_fraction.next_denominator GeneralizedContinuedFraction.nextDenominator

/--
Returns the next continuants `⟨Aₙ, Bₙ⟩` using `next_numerator` and `next_denominator`, where `pred`
is `⟨Aₙ₋₁, Bₙ₋₁⟩`, `ppred` is `⟨Aₙ₋₂, Bₙ₋₂⟩`, `a` is `aₙ₋₁`, and `b` is `bₙ₋₁`.
-/
def nextContinuants (a b : K) (ppred pred : Pair K) : Pair K :=
  ⟨nextNumerator a b ppred.a pred.a, nextDenominator a b ppred.b pred.b⟩
#align generalized_continued_fraction.next_continuants GeneralizedContinuedFraction.nextContinuants

/-- Returns the continuants `⟨Aₙ₋₁, Bₙ₋₁⟩` of `g`. -/
def continuantsAux (g : GeneralizedContinuedFraction K) : Stream' (Pair K)
  | 0 => ⟨1, 0⟩
  | 1 => ⟨g.h, 1⟩
  | n + 2 =>
    match g.s.get? n with
    | none => continuants_aux (n + 1)
    | some gp => nextContinuants gp.a gp.b (continuants_aux n) (continuants_aux <| n + 1)
#align generalized_continued_fraction.continuants_aux GeneralizedContinuedFraction.continuantsAux

/-- Returns the continuants `⟨Aₙ, Bₙ⟩` of `g`. -/
def continuants (g : GeneralizedContinuedFraction K) : Stream' (Pair K) :=
  g.continuantsAux.tail
#align generalized_continued_fraction.continuants GeneralizedContinuedFraction.continuants

/-- Returns the numerators `Aₙ` of `g`. -/
def numerators (g : GeneralizedContinuedFraction K) : Stream' K :=
  g.continuants.map Pair.a
#align generalized_continued_fraction.numerators GeneralizedContinuedFraction.numerators

/-- Returns the denominators `Bₙ` of `g`. -/
def denominators (g : GeneralizedContinuedFraction K) : Stream' K :=
  g.continuants.map Pair.b
#align generalized_continued_fraction.denominators GeneralizedContinuedFraction.denominators

/-- Returns the convergents `Aₙ / Bₙ` of `g`, where `Aₙ, Bₙ` are the nth continuants of `g`. -/
def convergents (g : GeneralizedContinuedFraction K) : Stream' K := fun n : ℕ =>
  g.numerators n / g.denominators n
#align generalized_continued_fraction.convergents GeneralizedContinuedFraction.convergents

/--
Returns the approximation of the fraction described by the given sequence up to a given position n.
For example, `convergents'_aux [(1, 2), (3, 4), (5, 6)] 2 = 1 / (2 + 3 / 4)` and
`convergents'_aux [(1, 2), (3, 4), (5, 6)] 0 = 0`.
-/
def convergents'Aux : Seq (Pair K) → ℕ → K
  | s, 0 => 0
  | s, n + 1 =>
    match s.headI with
    | none => 0
    | some gp => gp.a / (gp.b + convergents'_aux s.tail n)
#align generalized_continued_fraction.convergents'_aux GeneralizedContinuedFraction.convergents'Aux

/-- Returns the convergents of `g` by evaluating the fraction described by `g` up to a given
position `n`. For example, `convergents' [9; (1, 2), (3, 4), (5, 6)] 2 = 9 + 1 / (2 + 3 / 4)` and
`convergents' [9; (1, 2), (3, 4), (5, 6)] 0 = 9`
-/
def convergents' (g : GeneralizedContinuedFraction K) (n : ℕ) : K :=
  g.h + convergents'Aux g.s n
#align generalized_continued_fraction.convergents' GeneralizedContinuedFraction.convergents'

end GeneralizedContinuedFraction

-- Now, some basic, general theorems
namespace GeneralizedContinuedFraction

/-- Two gcfs `g` and `g'` are equal if and only if their components are equal. -/
protected theorem ext_iff {g g' : GeneralizedContinuedFraction α} :
    g = g' ↔ g.h = g'.h ∧ g.s = g'.s := by
  cases g
  cases g'
  simp
#align generalized_continued_fraction.ext_iff GeneralizedContinuedFraction.ext_iff

@[ext]
protected theorem ext {g g' : GeneralizedContinuedFraction α} (hyp : g.h = g'.h ∧ g.s = g'.s) :
    g = g' :=
  GeneralizedContinuedFraction.ext_iff.right hyp
#align generalized_continued_fraction.ext GeneralizedContinuedFraction.ext

end GeneralizedContinuedFraction


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.split_coequalizer
import category_theory.limits.preserves.basic

/-!
# Preserving (co)equalizers

Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers
to concrete (co)forks.

In particular, we show that `equalizer_comparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,g`, as well as the dual result.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

section equalizers
variables {X Y Z : C} {f g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)

/--
The map of a fork is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `fork.of_ι` with `functor.map_cone`.
-/
def is_limit_map_cone_fork_equiv :
  is_limit (G.map_cone (fork.of_ι h w)) ≃
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
(is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans
  (is_limit.equiv_iso_limit (fork.ext (iso.refl _) (by { simp [fork.ι] })))

/-- The property of preserving equalizers expressed in terms of forks. -/
def is_limit_fork_map_of_is_limit [preserves_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι h w)) :
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
is_limit_map_cone_fork_equiv G w (preserves_limit.preserves l)

/-- The property of reflecting equalizers expressed in terms of forks. -/
def is_limit_of_is_limit_fork_map [reflects_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g))) :
  is_limit (fork.of_ι h w) :=
reflects_limit.reflects ((is_limit_map_cone_fork_equiv G w).symm l)

variables (f g) [has_equalizer f g]

/--
If `G` preserves equalizers and `C` has them, then the fork constructed of the mapped morphisms of
a fork is a limit.
-/
def is_limit_of_has_equalizer_of_preserves_limit
  [preserves_limit (parallel_pair f g) G] :
  is_limit (fork.of_ι (G.map (equalizer.ι f g))
                      (by simp only [←G.map_comp, equalizer.condition])) :=
is_limit_fork_map_of_is_limit G _ (equalizer_is_equalizer f g)

variables [has_equalizer (G.map f) (G.map g)]

/--
If the equalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
equalizer of `(f,g)`.
-/
def preserves_equalizer.of_iso_comparison [i : is_iso (equalizer_comparison f g G)] :
  preserves_limit (parallel_pair f g) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (equalizer_is_equalizer f g),
  apply (is_limit_map_cone_fork_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_limit (parallel_pair f g) G]
/--
If `G` preserves the equalizer of `(f,g)`, then the equalizer comparison map for `G` at `(f,g)` is
an isomorphism.
-/
def preserves_equalizer.iso :
  G.obj (equalizer f g) ≅ equalizer (G.map f) (G.map g) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_equalizer_of_preserves_limit G f g)
  (limit.is_limit _)

@[simp]
lemma preserves_equalizer.iso_hom :
  (preserves_equalizer.iso G f g).hom = equalizer_comparison f g G :=
rfl

instance : is_iso (equalizer_comparison f g G) :=
begin
  rw ← preserves_equalizer.iso_hom,
  apply_instance
end

end equalizers

section coequalizers

variables {X Y Z : C} {f g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)

/--
The map of a cofork is a colimit iff the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofork.of_π` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofork_equiv :
  is_colimit (G.map_cocone (cofork.of_π h w)) ≃
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
(is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans $
is_colimit.equiv_iso_colimit $ cofork.ext (iso.refl _) $
begin
  dsimp only [cofork.π, cofork.of_π_ι_app],
  dsimp, rw [category.comp_id, category.id_comp]
end

/-- The property of preserving coequalizers expressed in terms of coforks. -/
def is_colimit_cofork_map_of_is_colimit [preserves_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π h w)) :
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
is_colimit_map_cocone_cofork_equiv G w (preserves_colimit.preserves l)

/-- The property of reflecting coequalizers expressed in terms of coforks. -/
def is_colimit_of_is_colimit_cofork_map [reflects_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w])
                  : cofork (G.map f) (G.map g))) :
  is_colimit (cofork.of_π h w) :=
reflects_colimit.reflects ((is_colimit_map_cocone_cofork_equiv G w).symm l)

variables (f g) [has_coequalizer f g]

/--
If `G` preserves coequalizers and `C` has them, then the cofork constructed of the mapped morphisms
of a cofork is a colimit.
-/
def is_colimit_of_has_coequalizer_of_preserves_colimit
  [preserves_colimit (parallel_pair f g) G] :
  is_colimit (cofork.of_π (G.map (coequalizer.π f g)) _) :=
is_colimit_cofork_map_of_is_colimit G _ (coequalizer_is_coequalizer f g)

variables [has_coequalizer (G.map f) (G.map g)]

/--
If the coequalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
coequalizer of `(f,g)`.
-/
def of_iso_comparison [i : is_iso (coequalizer_comparison f g G)] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (coequalizer_is_coequalizer f g),
  apply (is_colimit_map_cocone_cofork_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_colimit (parallel_pair f g) G]
/--
If `G` preserves the coequalizer of `(f,g)`, then the coequalizer comparison map for `G` at `(f,g)`
is an isomorphism.
-/
def preserves_coequalizer.iso :
  coequalizer (G.map f) (G.map g) ≅ G.obj (coequalizer f g) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (is_colimit_of_has_coequalizer_of_preserves_colimit G f g)

@[simp]
lemma preserves_coequalizer.iso_hom :
  (preserves_coequalizer.iso G f g).hom = coequalizer_comparison f g G :=
rfl

instance : is_iso (coequalizer_comparison f g G) :=
begin
  rw ← preserves_coequalizer.iso_hom,
  apply_instance
end

/-- Any functor preserves coequalizers of split pairs. -/
@[priority 1]
instance preserves_split_coequalizers (f g : X ⟶ Y) [has_split_coequalizer f g] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone
            ((has_split_coequalizer.is_split_coequalizer f g).is_coequalizer),
  apply (is_colimit_map_cocone_cofork_equiv G _).symm
            ((has_split_coequalizer.is_split_coequalizer f g).map G).is_coequalizer,
end
end coequalizers

end category_theory.limits


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton
-/
import category_theory.fully_faithful

/-!
# Induced categories and full subcategories

Given a category `D` and a function `F : C → D `from a type `C` to the
objects of `D`, there is an essentially unique way to give `C` a
category structure such that `F` becomes a fully faithful functor,
namely by taking $$ Hom_C(X, Y) = Hom_D(FX, FY) $$. We call this the
category induced from `D` along `F`.

As a special case, if `C` is a subtype of `D`,
this produces the full subcategory of `D` on the objects belonging to `C`.
In general the induced category is equivalent to the full subcategory of `D` on the
image of `F`.

## Implementation notes

It looks odd to make `D` an explicit argument of `induced_category`,
when it is determined by the argument `F` anyways. The reason to make `D`
explicit is in order to control its syntactic form, so that instances
like `induced_category.has_forget₂` (elsewhere) refer to the correct
form of D. This is used to set up several algebraic categories like

  def CommMon : Type (u+1) := induced_category Mon (bundled.map @comm_monoid.to_monoid)
  -- not `induced_category (bundled monoid) (bundled.map @comm_monoid.to_monoid)`,
  -- even though `Mon = bundled monoid`!
-/

namespace category_theory

universes v u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

section induced

variables {C : Type u₁} (D : Type u₂) [category.{v} D]
variables (F : C → D)
include F

/--
`induced_category D F`, where `F : C → D`, is a typeclass synonym for `C`,
which provides a category structure so that the morphisms `X ⟶ Y` are the morphisms
in `D` from `F X` to `F Y`.
-/
@[nolint has_inhabited_instance unused_arguments]
def induced_category : Type u₁ := C

variables {D}

instance induced_category.has_coe_to_sort {α : Sort*} [has_coe_to_sort D α] :
  has_coe_to_sort (induced_category D F) α :=
⟨λ c, ↥(F c)⟩

instance induced_category.category : category.{v} (induced_category D F) :=
{ hom  := λ X Y, F X ⟶ F Y,
  id   := λ X, 𝟙 (F X),
  comp := λ _ _ _ f g, f ≫ g }

/--
The forgetful functor from an induced category to the original category,
forgetting the extra data.
-/
@[simps] def induced_functor : induced_category D F ⥤ D :=
{ obj := F, map := λ x y f, f }

instance induced_category.full : full (induced_functor F) :=
{ preimage := λ x y f, f }
instance induced_category.faithful : faithful (induced_functor F) := {}

end induced

section full_subcategory
/- A full subcategory is the special case of an induced category with F = subtype.val. -/

variables {C : Type u₂} [category.{v} C]
variables (Z : C → Prop)

/--
The category structure on a subtype; morphisms just ignore the property.

See https://stacks.math.columbia.edu/tag/001D. We do not define 'strictly full' subcategories.
-/
instance full_subcategory : category.{v} {X : C // Z X} :=
induced_category.category subtype.val

/--
The forgetful functor from a full subcategory into the original category
("forgetting" the condition).
-/
def full_subcategory_inclusion : {X : C // Z X} ⥤ C :=
induced_functor subtype.val

@[simp] lemma full_subcategory_inclusion.obj {X} :
  (full_subcategory_inclusion Z).obj X = X.val := rfl
@[simp] lemma full_subcategory_inclusion.map {X Y} {f : X ⟶ Y} :
  (full_subcategory_inclusion Z).map f = f := rfl

instance full_subcategory.full : full (full_subcategory_inclusion Z) :=
induced_category.full subtype.val
instance full_subcategory.faithful : faithful (full_subcategory_inclusion Z) :=
induced_category.faithful subtype.val

end full_subcategory

end category_theory


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

import Mathlib.Data.Finset.Basic

import ProofChecker.Data.HashMap.Lemmas

def HashSet (α : Type) [BEq α] [Hashable α] := HashMap α Unit

namespace HashSet

variable {α : Type} [BEq α] [Hashable α]

def empty (α : Type) [BEq α] [Hashable α] : HashSet α :=
  HashMap.empty

def isEmpty (s : HashSet α) : Bool :=
  HashMap.isEmpty s

def insert (s : HashSet α) (a : α) : HashSet α :=
  HashMap.insert s a ()

def singleton (a : α) : HashSet α :=
  empty α |>.insert a

def contains (s : HashSet α) (a : α) : Bool :=
  HashMap.contains s a

def union (s t : HashSet α) : HashSet α :=
  HashMap.fold (init := s) (fun acc a _ => acc.insert a) t

def inter (s t : HashSet α) : HashSet α :=
  HashMap.fold (init := empty α) (fun acc a _ =>
    if s.contains a then acc.insert a else acc) t

variable [DecidableEq α]

def toFinset (s : HashSet α) : Finset α :=
  HashMap.fold (init := ∅) (fun X a _ => Insert.insert a X) s

variable [LawfulBEq α] [HashMap.LawfulHashable α]

theorem toFinset_sub (s : HashSet α) (a : α) : a ∈ s.toFinset → s.contains a := by
  dsimp [toFinset]
  apply HashMap.foldRecOn
    (C := fun acc => a ∈ acc → s.contains a)
    (hInit := by simp)
  simp only [Finset.mem_insert]
  intro _ a _ ih hFind hMem
  cases hMem with
  | inl h =>
    apply HashMap.contains_iff _ _ |>.mpr
    exact h ▸ ⟨_, hFind⟩
  | inr h => exact ih h

theorem sub_toFinset (s : HashSet α) (a : α) : s.contains a → a ∈ s.toFinset := by
  dsimp [toFinset, contains]
  intro hContains
  have ⟨_, hFind⟩ := HashMap.contains_iff _ _ |>.mp hContains
  have ⟨_, hEq⟩ := HashMap.fold_of_mapsTo_of_comm s (fun (X : Finset α) a _ => Insert.insert a X) ∅
    hFind ?comm
  case comm =>
    intros
    ext
    aesop
  simp [hEq]

theorem mem_toFinset (s : HashSet α) (a : α) : a ∈ s.toFinset ↔ s.contains a :=
  ⟨toFinset_sub s a, sub_toFinset s a⟩

theorem not_mem_toFinset (s : HashSet α) (a : α) : a ∉ s.toFinset ↔ ¬s.contains a := by
  simp [mem_toFinset]

@[simp]
theorem toFinset_empty : toFinset (empty α) = ∅ := by
  ext
  simp [mem_toFinset, empty, contains, HashMap.not_contains_empty]

theorem toFinset_of_isEmpty (s : HashSet α) : s.isEmpty → s.toFinset = ∅ := by
  intro h
  ext
  simp [mem_toFinset, contains, HashMap.not_contains_of_isEmpty _ _ h]

@[simp]
theorem toFinset_insert (s : HashSet α) (a : α) :
    toFinset (s.insert a) = Insert.insert a s.toFinset := by
  ext
  simp [mem_toFinset, insert, contains, HashMap.contains_insert]
  tauto

@[simp]
theorem toFinset_singleton (a : α) : toFinset (singleton a) = {a} := by
  simp [singleton, toFinset_insert]

theorem toFinset_union_sub (s t : HashSet α) : (s.union t).toFinset ⊆ s.toFinset ∪ t.toFinset := by
  dsimp [union]
  intro x
  apply HashMap.foldRecOn
    (C := fun (acc : HashSet α) => x ∈ acc.toFinset → x ∈ s.toFinset ∪ t.toFinset)
    (hInit := by simp; tauto)
  intro _ a _ _ hFind
  have : a ∈ t.toFinset := by
    have := HashMap.contains_iff _ _|>.mpr ⟨_, hFind⟩
    simp [mem_toFinset, contains, this]
  aesop

theorem sub_toFinset_union_left (s t : HashSet α) : s.toFinset ⊆ (s.union t).toFinset := by
  dsimp [union]
  intro x
  apply HashMap.foldRecOn
    (C := fun (acc : HashSet α) => x ∈ s.toFinset → x ∈ acc.toFinset)
    (hInit := id)
  aesop

theorem sub_toFinset_union (s t : HashSet α) : s.toFinset ∪ t.toFinset ⊆ (s.union t).toFinset := by
  apply Finset.union_subset (sub_toFinset_union_left s t)
  dsimp [union]
  intro _ h
  have ⟨_, hFind⟩ := HashMap.contains_iff _ _|>.mp (mem_toFinset _ _ |>.mp h)
  have ⟨_, h⟩ := HashMap.fold_of_mapsTo_of_comm t (init := s) (fun acc a _ => acc.insert a)
    hFind (by intros; apply HashMap.insert_comm)
  simp [h]

@[simp]
theorem toFinset_union (s t : HashSet α) : (s.union t).toFinset = s.toFinset ∪ t.toFinset :=
  subset_antisymm (toFinset_union_sub s t) (sub_toFinset_union s t)

theorem toFinset_inter_sub (s t : HashSet α) : (s.inter t).toFinset ⊆ s.toFinset ∩ t.toFinset := by
  dsimp [inter]
  intro x
  apply HashMap.foldRecOn
    (C := fun (acc : HashSet α) => x ∈ acc.toFinset → x ∈ s.toFinset ∩ t.toFinset)
    (hInit := by simp)
  intro _ a _ _ hFind
  have : a ∈ t.toFinset := by
    have := HashMap.contains_iff _ _|>.mpr ⟨_, hFind⟩
    simp [mem_toFinset, contains, this]
  split <;>
    aesop (add norm mem_toFinset)

theorem sub_toFinset_inter (s t : HashSet α) : s.toFinset ∩ t.toFinset ⊆ (s.inter t).toFinset := by
  intro x
  simp only [inter, Finset.mem_inter]
  intro ⟨hS, hT⟩
  have ⟨_, hFind⟩ := HashMap.contains_iff _ _|>.mp (mem_toFinset _ _ |>.mp hT)
  have ⟨_, h⟩ := HashMap.fold_of_mapsTo_of_comm t (init := empty α)
    (fun acc a _ => if s.contains a then acc.insert a else acc)
    hFind ?comm
  case comm =>
    intros
    dsimp [insert]
    split_ifs <;>
      aesop (add norm HashMap.insert_comm)
  rw [h]
  split
  . simp
  . have : x ∉ s.toFinset :=
      not_mem_toFinset _ _ |>.mpr (by assumption)
    contradiction

@[simp]
theorem toFinset_inter (s t : HashSet α) : (s.inter t).toFinset = s.toFinset ∩ t.toFinset :=
  subset_antisymm (toFinset_inter_sub s t) (sub_toFinset_inter s t)

def Union (l : Array (HashSet α)) : HashSet α :=
  l.foldl (init := empty α) union

theorem toFinset_Union (l : Array (HashSet α)) :
    toFinset (Union l) = l.foldl (init := ∅) fun acc s => acc ∪ s.toFinset := by
  have : ∀ t, toFinset (l.foldl (init := t) union) =
      l.foldl (init := t.toFinset) fun acc s => acc ∪ s.toFinset := by
    simp only [Array.foldl_eq_foldl_data]
    induction l.data <;> simp_all
  simp [Union, this]

/-- Calculate the union of an array of `HashSet`s, and check if the array elements are all pairwise
disjoint. Return `(⋃ ss, true)` if array elements are pairwise disjoint, otherwise `(⋃ ss, false)`.
-/
def disjointUnion (ss : Array (HashSet α)) : HashSet α × Bool :=
  ss.foldl (init := (.empty α, true)) fun (U, b) t =>
    (U.union t, b && (U.inter t).isEmpty)

theorem disjointUnion_characterization (ss : Array (HashSet α)) :
    (∀ a, a ∈ (disjointUnion ss).fst.toFinset ↔ ∃ s ∈ ss.data, a ∈ s.toFinset)
    ∧ ((disjointUnion ss).snd →
      ∀ (i j : Fin ss.size), i ≠ j → ss[i].toFinset ∩ ss[j].toFinset = ∅) :=
  have ⟨h₁, h₂, h₃⟩ := ss.foldl_induction
    (motive := fun i (acc : HashSet α × Bool) =>
      (∀ a ∈ acc.1.toFinset, ∃ s ∈ ss.data, a ∈ s.toFinset) ∧
      (∀ (j : Fin ss.size), j < i → ss[j].toFinset ⊆ acc.1.toFinset) ∧
      (acc.2 → ∀ (j k : Fin ss.size), j < i → k < i → j ≠ k → ss[j].toFinset ∩ ss[k].toFinset = ∅))
    (init := (empty α, true)) (h0 := by simp)
    (f := fun acc t =>
      (acc.1.union t, acc.2 && (acc.1.inter t).isEmpty))
    (hf := by
      intro i (U, b) ⟨ih₁, ih₂, ih₃⟩
      simp only [toFinset_union, Finset.mem_union]
      refine ⟨?step₁, ?step₂, ?step₃⟩
      case step₁ =>
        intro a hMem
        cases hMem with
        | inl h =>
          exact ih₁ a h
        | inr h =>
          exact ⟨ss[i], Array.get_mem_data ss i, h⟩
      case step₂ =>
        intro j hJ
        cases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hJ) with
        | inl h =>
          have := ih₂ j h
          exact subset_trans this (Finset.subset_union_left _ _)
        | inr h =>
          simp [h, Finset.subset_union_right]
      case step₃ =>
        intro hB j k hJ hK hNe
        simp only [Bool.and_eq_true] at hB
        cases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hJ) <;>
          cases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hK)
        case inl.inl hJ hK =>
          exact ih₃ hB.left j k hJ hK hNe
        case inr.inr hJ hK =>
          have := hJ.trans hK.symm
          exact absurd (Fin.eq_of_val_eq this) hNe
        case inl.inr hJ hK =>
          have hB := toFinset_of_isEmpty _ hB.right
          simp only [toFinset_inter] at hB
          apply Finset.subset_empty.mp
          have := ih₂ j hJ
          have := Finset.inter_subset_inter_right this (u := ss[k].toFinset)
          simp_all
        case inr.inl hJ hK =>
          have hB := toFinset_of_isEmpty _ hB.right
          rw [toFinset_inter, Finset.inter_comm] at hB
          apply Finset.subset_empty.mp
          have := ih₂ k hK
          have := Finset.inter_subset_inter_left this (s := ss[j].toFinset)
          simp_all)
  by
    dsimp [disjointUnion]
    refine ⟨fun a => ⟨fun hMem => h₁ a hMem, ?_⟩,
      fun h i j hNe => h₃ h i j i.isLt j.isLt hNe⟩
    intro ⟨s, hS, hA⟩
    have ⟨i, hI⟩ := Array.get_of_mem_data hS
    exact h₂ i i.isLt (hI ▸ hA)

theorem mem_disjointUnion (ss : Array (HashSet α)) (a : α) :
    a ∈ (disjointUnion ss).fst.toFinset ↔ ∃ s ∈ ss.data, a ∈ s.toFinset :=
  disjointUnion_characterization ss |>.left a

theorem disjoint_disjointUnion (ss : Array (HashSet α)) : (disjointUnion ss).snd →
    ∀ (i j : Nat) (hI : i < ss.size) (hJ : j < ss.size), i ≠ j →
      ss[i].toFinset ∩ ss[j].toFinset = ∅ :=
  fun h i j hI hJ hNe =>
    disjointUnion_characterization ss |>.right h ⟨i, hI⟩ ⟨j, hJ⟩ (by simp [hNe])

end HashSet