/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jeremy Avigad, Yury Kudryashov

! This file was ported from Lean 3 source module order.filter.ultrafilter
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Filter.Cofinite
import Mathlib.Order.ZornAtoms

/-!
# Ultrafilters

An ultrafilter is a minimal (maximal in the set order) proper filter.
In this file we define

* `Ultrafilter.of`: an ultrafilter that is less than or equal to a given filter;
* `Ultrafilter`: subtype of ultrafilters;
* `pure x : Ultrafilter α`: `pure x` as an `ultrafiler`;
* `Ultrafilter.map`, `Ultrafilter.bind`, `Ultrafilter.comap` : operations on ultrafilters;
* `hyperfilter`: the ultrafilter extending the cofinite filter.
-/

universe u v

variable {α : Type u} {β : Type v} {γ : Type _}

open Set Filter Function

open Classical Filter

/-- `Filter α` is an atomic type: for every filter there exists an ultrafilter that is less than or
equal to this filter. -/
instance : IsAtomic (Filter α) :=
  IsAtomic.of_isChain_bounded fun c hc hne hb =>
    ⟨infₛ c, (infₛ_neBot_of_directed' hne (show IsChain (· ≥ ·) c from hc.symm).directedOn hb).ne,
      fun _ hx => infₛ_le hx⟩

/-- An ultrafilter is a minimal (maximal in the set order) proper filter. -/
structure Ultrafilter (α : Type _) extends Filter α where
  /-- An ultrafilter is nontrivial. -/
  protected neBot' : NeBot toFilter
  /-- If `g` is a nontrivial filter that is less than or equal to an ultrafilter, then it is greater
  than or equal to the ultrafilter. -/
  protected le_of_le : ∀ g, Filter.NeBot g → g ≤ toFilter → toFilter ≤ g
#align ultrafilter Ultrafilter

namespace Ultrafilter

variable {f g : Ultrafilter α} {s t : Set α} {p q : α → Prop}

attribute [coe] Ultrafilter.toFilter

instance : CoeTC (Ultrafilter α) (Filter α) :=
  ⟨Ultrafilter.toFilter⟩

instance : Membership (Set α) (Ultrafilter α) :=
  ⟨fun s f => s ∈ (f : Filter α)⟩

theorem unique (f : Ultrafilter α) {g : Filter α} (h : g ≤ f) (hne : NeBot g := by infer_instance) :
    g = f :=
  le_antisymm h <| f.le_of_le g hne h
#align ultrafilter.unique Ultrafilter.unique

instance neBot (f : Ultrafilter α) : NeBot (f : Filter α) :=
  f.neBot'
#align ultrafilter.ne_bot Ultrafilter.neBot

protected theorem isAtom (f : Ultrafilter α) : IsAtom (f : Filter α) :=
  ⟨f.neBot.ne, fun _ hgf => by_contra fun hg => hgf.ne <| f.unique hgf.le ⟨hg⟩⟩
#align ultrafilter.is_atom Ultrafilter.isAtom

@[simp, norm_cast]
theorem mem_coe : s ∈ (f : Filter α) ↔ s ∈ f :=
  Iff.rfl
#align ultrafilter.mem_coe Ultrafilter.mem_coe

theorem coe_injective : Injective ((↑) : Ultrafilter α → Filter α)
  | ⟨f, h₁, h₂⟩, ⟨g, _, _⟩, _ => by congr
#align ultrafilter.coe_injective Ultrafilter.coe_injective

theorem eq_of_le {f g : Ultrafilter α} (h : (f : Filter α) ≤ g) : f = g :=
  coe_injective (g.unique h)
#align ultrafilter.eq_of_le Ultrafilter.eq_of_le

@[simp, norm_cast]
theorem coe_le_coe {f g : Ultrafilter α} : (f : Filter α) ≤ g ↔ f = g :=
  ⟨fun h => eq_of_le h, fun h => h ▸ le_rfl⟩
#align ultrafilter.coe_le_coe Ultrafilter.coe_le_coe

@[simp, norm_cast]
theorem coe_inj : (f : Filter α) = g ↔ f = g :=
  coe_injective.eq_iff
#align ultrafilter.coe_inj Ultrafilter.coe_inj

@[ext]
theorem ext ⦃f g : Ultrafilter α⦄ (h : ∀ s, s ∈ f ↔ s ∈ g) : f = g :=
  coe_injective <| Filter.ext h
#align ultrafilter.ext Ultrafilter.ext

theorem le_of_inf_neBot (f : Ultrafilter α) {g : Filter α} (hg : NeBot (↑f ⊓ g)) : ↑f ≤ g :=
  le_of_inf_eq (f.unique inf_le_left hg)
#align ultrafilter.le_of_inf_ne_bot Ultrafilter.le_of_inf_neBot

theorem le_of_inf_neBot' (f : Ultrafilter α) {g : Filter α} (hg : NeBot (g ⊓ f)) : ↑f ≤ g :=
  f.le_of_inf_neBot <| by rwa [inf_comm]
#align ultrafilter.le_of_inf_ne_bot' Ultrafilter.le_of_inf_neBot'

theorem inf_neBot_iff {f : Ultrafilter α} {g : Filter α} : NeBot (↑f ⊓ g) ↔ ↑f ≤ g :=
  ⟨le_of_inf_neBot f, fun h => (inf_of_le_left h).symm ▸ f.neBot⟩
#align ultrafilter.inf_ne_bot_iff Ultrafilter.inf_neBot_iff

theorem disjoint_iff_not_le {f : Ultrafilter α} {g : Filter α} : Disjoint (↑f) g ↔ ¬↑f ≤ g := by
  rw [← inf_neBot_iff, neBot_iff, Ne.def, not_not, disjoint_iff]
#align ultrafilter.disjoint_iff_not_le Ultrafilter.disjoint_iff_not_le

@[simp]
theorem compl_not_mem_iff : sᶜ ∉ f ↔ s ∈ f :=
  ⟨fun hsc =>
    le_principal_iff.1 <|
      f.le_of_inf_neBot ⟨fun h => hsc <| mem_of_eq_bot <| by rwa [compl_compl]⟩,
    compl_not_mem⟩
#align ultrafilter.compl_not_mem_iff Ultrafilter.compl_not_mem_iff

@[simp]
theorem frequently_iff_eventually : (∃ᶠ x in f, p x) ↔ ∀ᶠ x in f, p x :=
  compl_not_mem_iff
#align ultrafilter.frequently_iff_eventually Ultrafilter.frequently_iff_eventually

alias frequently_iff_eventually ↔ _root_.Filter.Frequently.eventually _
#align filter.frequently.eventually Filter.Frequently.eventually

theorem compl_mem_iff_not_mem : sᶜ ∈ f ↔ s ∉ f := by rw [← compl_not_mem_iff, compl_compl]
#align ultrafilter.compl_mem_iff_not_mem Ultrafilter.compl_mem_iff_not_mem

theorem diff_mem_iff (f : Ultrafilter α) : s \ t ∈ f ↔ s ∈ f ∧ t ∉ f :=
  inter_mem_iff.trans <| and_congr Iff.rfl compl_mem_iff_not_mem
#align ultrafilter.diff_mem_iff Ultrafilter.diff_mem_iff

/-- If `sᶜ ∉ f ↔ s ∈ f`, then `f` is an ultrafilter. The other implication is given by
`Ultrafilter.compl_not_mem_iff`.  -/
def ofComplNotMemIff (f : Filter α) (h : ∀ s, sᶜ ∉ f ↔ s ∈ f) : Ultrafilter α where
  toFilter := f
  neBot' := ⟨fun hf => by simp [hf] at h⟩
  le_of_le g hg hgf s hs := (h s).1 fun hsc => compl_not_mem hs (hgf hsc)
#align ultrafilter.of_compl_not_mem_iff Ultrafilter.ofComplNotMemIff

/-- If `f : Filter α` is an atom, then it is an ultrafilter. -/
def ofAtom (f : Filter α) (hf : IsAtom f) : Ultrafilter α where
  toFilter := f
  neBot' := ⟨hf.1⟩
  le_of_le g hg := (isAtom_iff.1 hf).2 g hg.ne
#align ultrafilter.of_atom Ultrafilter.ofAtom

theorem nonempty_of_mem (hs : s ∈ f) : s.Nonempty :=
  Filter.nonempty_of_mem hs
#align ultrafilter.nonempty_of_mem Ultrafilter.nonempty_of_mem

theorem ne_empty_of_mem (hs : s ∈ f) : s ≠ ∅ :=
  (nonempty_of_mem hs).ne_empty
#align ultrafilter.ne_empty_of_mem Ultrafilter.ne_empty_of_mem

@[simp]
theorem empty_not_mem : ∅ ∉ f :=
  Filter.empty_not_mem (f : Filter α)
#align ultrafilter.empty_not_mem Ultrafilter.empty_not_mem

@[simp]
theorem le_sup_iff {u : Ultrafilter α} {f g : Filter α} : ↑u ≤ f ⊔ g ↔ ↑u ≤ f ∨ ↑u ≤ g :=
  not_iff_not.1 <| by simp only [← disjoint_iff_not_le, not_or, disjoint_sup_right]
#align ultrafilter.le_sup_iff Ultrafilter.le_sup_iff

@[simp]
theorem union_mem_iff : s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f := by
  simp only [← mem_coe, ← le_principal_iff, ← sup_principal, le_sup_iff]
#align ultrafilter.union_mem_iff Ultrafilter.union_mem_iff

theorem mem_or_compl_mem (f : Ultrafilter α) (s : Set α) : s ∈ f ∨ sᶜ ∈ f :=
  or_iff_not_imp_left.2 compl_mem_iff_not_mem.2
#align ultrafilter.mem_or_compl_mem Ultrafilter.mem_or_compl_mem

protected theorem em (f : Ultrafilter α) (p : α → Prop) : (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, ¬p x :=
  f.mem_or_compl_mem { x | p x }
#align ultrafilter.em Ultrafilter.em

theorem eventually_or : (∀ᶠ x in f, p x ∨ q x) ↔ (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, q x :=
  union_mem_iff
#align ultrafilter.eventually_or Ultrafilter.eventually_or

theorem eventually_not : (∀ᶠ x in f, ¬p x) ↔ ¬∀ᶠ x in f, p x :=
  compl_mem_iff_not_mem
#align ultrafilter.eventually_not Ultrafilter.eventually_not

theorem eventually_imp : (∀ᶠ x in f, p x → q x) ↔ (∀ᶠ x in f, p x) → ∀ᶠ x in f, q x := by
  simp only [imp_iff_not_or, eventually_or, eventually_not]
#align ultrafilter.eventually_imp Ultrafilter.eventually_imp

theorem finite_unionₛ_mem_iff {s : Set (Set α)} (hs : s.Finite) : ⋃₀ s ∈ f ↔ ∃ t ∈ s, t ∈ f :=
  Finite.induction_on hs (by simp) fun _ _ his => by
    simp [union_mem_iff, his, or_and_right, exists_or]
#align ultrafilter.finite_sUnion_mem_iff Ultrafilter.finite_unionₛ_mem_iff

theorem finite_bunionᵢ_mem_iff {is : Set β} {s : β → Set α} (his : is.Finite) :
    (⋃ i ∈ is, s i) ∈ f ↔ ∃ i ∈ is, s i ∈ f := by
  simp only [← unionₛ_image, finite_unionₛ_mem_iff (his.image s), bex_image_iff]
#align ultrafilter.finite_bUnion_mem_iff Ultrafilter.finite_bunionᵢ_mem_iff

/-- Pushforward for ultrafilters. -/
nonrec def map (m : α → β) (f : Ultrafilter α) : Ultrafilter β :=
  ofComplNotMemIff (map m f) fun s => @compl_not_mem_iff _ f (m ⁻¹' s)
#align ultrafilter.map Ultrafilter.map

@[simp, norm_cast]
theorem coe_map (m : α → β) (f : Ultrafilter α) : (map m f : Filter β) = Filter.map m ↑f :=
  rfl
#align ultrafilter.coe_map Ultrafilter.coe_map

@[simp]
theorem mem_map {m : α → β} {f : Ultrafilter α} {s : Set β} : s ∈ map m f ↔ m ⁻¹' s ∈ f :=
  Iff.rfl
#align ultrafilter.mem_map Ultrafilter.mem_map

@[simp]
nonrec theorem map_id (f : Ultrafilter α) : f.map id = f :=
  coe_injective map_id
#align ultrafilter.map_id Ultrafilter.map_id

@[simp]
theorem map_id' (f : Ultrafilter α) : (f.map fun x => x) = f :=
  map_id _
#align ultrafilter.map_id' Ultrafilter.map_id'

@[simp]
nonrec theorem map_map (f : Ultrafilter α) (m : α → β) (n : β → γ) :
  (f.map m).map n = f.map (n ∘ m) :=
  coe_injective map_map
#align ultrafilter.map_map Ultrafilter.map_map

/-- The pullback of an ultrafilter along an injection whose range is large with respect to the given
ultrafilter. -/
nonrec def comap {m : α → β} (u : Ultrafilter β) (inj : Injective m) (large : Set.range m ∈ u) :
    Ultrafilter α where
  toFilter := comap m u
  neBot' := u.neBot'.comap_of_range_mem large
  le_of_le g hg hgu := by
    simp only [← u.unique (map_le_iff_le_comap.2 hgu), comap_map inj, le_rfl]
#align ultrafilter.comap Ultrafilter.comap

@[simp]
theorem mem_comap {m : α → β} (u : Ultrafilter β) (inj : Injective m) (large : Set.range m ∈ u)
    {s : Set α} : s ∈ u.comap inj large ↔ m '' s ∈ u :=
  mem_comap_iff inj large
#align ultrafilter.mem_comap Ultrafilter.mem_comap

@[simp, norm_cast]
theorem coe_comap {m : α → β} (u : Ultrafilter β) (inj : Injective m) (large : Set.range m ∈ u) :
    (u.comap inj large : Filter α) = Filter.comap m u :=
  rfl
#align ultrafilter.coe_comap Ultrafilter.coe_comap

@[simp]
nonrec theorem comap_id (f : Ultrafilter α) (h₀ : Injective (id : α → α) := injective_id)
    (h₁ : range id ∈ f := (by rw [range_id]; exact univ_mem)) :
    f.comap h₀ h₁ = f :=
  coe_injective comap_id
#align ultrafilter.comap_id Ultrafilter.comap_id

@[simp]
nonrec theorem comap_comap (f : Ultrafilter γ) {m : α → β} {n : β → γ} (inj₀ : Injective n)
    (large₀ : range n ∈ f) (inj₁ : Injective m) (large₁ : range m ∈ f.comap inj₀ large₀)
    (inj₂ : Injective (n ∘ m) := inj₀.comp inj₁)
    (large₂ : range (n ∘ m) ∈ f :=
      (by rw [range_comp]; exact image_mem_of_mem_comap large₀ large₁)) :
    (f.comap inj₀ large₀).comap inj₁ large₁ = f.comap inj₂ large₂ :=
  coe_injective comap_comap
#align ultrafilter.comap_comap Ultrafilter.comap_comap

/-- The principal ultrafilter associated to a point `x`. -/
instance : Pure Ultrafilter :=
  ⟨fun a => ofComplNotMemIff (pure a) fun s => by simp⟩

@[simp]
theorem mem_pure {a : α} {s : Set α} : s ∈ (pure a : Ultrafilter α) ↔ a ∈ s :=
  Iff.rfl
#align ultrafilter.mem_pure Ultrafilter.mem_pure

@[simp]
theorem coe_pure (a : α) : ↑(pure a : Ultrafilter α) = (pure a : Filter α) :=
  rfl
#align ultrafilter.coe_pure Ultrafilter.coe_pure

@[simp]
theorem map_pure (m : α → β) (a : α) : map m (pure a) = pure (m a) :=
  rfl
#align ultrafilter.map_pure Ultrafilter.map_pure

@[simp]
theorem comap_pure {m : α → β} (a : α) (inj : Injective m) (large) :
    comap (pure <| m a) inj large = pure a :=
  coe_injective <|
    comap_pure.trans <| by
      rw [coe_pure, ← principal_singleton, ← image_singleton, preimage_image_eq _ inj]
#align ultrafilter.comap_pure Ultrafilter.comap_pure

theorem pure_injective : Injective (pure : α → Ultrafilter α) := fun _ _ h =>
  Filter.pure_injective (congr_arg Ultrafilter.toFilter h : _)
#align ultrafilter.pure_injective Ultrafilter.pure_injective

instance [Inhabited α] : Inhabited (Ultrafilter α) :=
  ⟨pure default⟩

instance [Nonempty α] : Nonempty (Ultrafilter α) :=
  Nonempty.map pure inferInstance

theorem eq_pure_of_finite_mem (h : s.Finite) (h' : s ∈ f) : ∃ x ∈ s, f = pure x := by
  rw [← bunionᵢ_of_singleton s] at h'
  rcases(Ultrafilter.finite_bunionᵢ_mem_iff h).mp h' with ⟨a, has, haf⟩
  exact ⟨a, has, eq_of_le (Filter.le_pure_iff.2 haf)⟩
#align ultrafilter.eq_pure_of_finite_mem Ultrafilter.eq_pure_of_finite_mem

theorem eq_pure_of_finite [Finite α] (f : Ultrafilter α) : ∃ a, f = pure a :=
  (eq_pure_of_finite_mem finite_univ univ_mem).imp fun _ ⟨_, ha⟩ => ha
#align ultrafilter.eq_pure_of_finite Ultrafilter.eq_pure_of_finite

theorem le_cofinite_or_eq_pure (f : Ultrafilter α) : (f : Filter α) ≤ cofinite ∨ ∃ a, f = pure a :=
  or_iff_not_imp_left.2 fun h =>
    let ⟨_, hs, hfin⟩ := Filter.disjoint_cofinite_right.1 (disjoint_iff_not_le.2 h)
    let ⟨a, _, hf⟩ := eq_pure_of_finite_mem hfin hs
    ⟨a, hf⟩
#align ultrafilter.le_cofinite_or_eq_pure Ultrafilter.le_cofinite_or_eq_pure

/-- Monadic bind for ultrafilters, coming from the one on filters
defined in terms of map and join.-/
def bind (f : Ultrafilter α) (m : α → Ultrafilter β) : Ultrafilter β :=
  ofComplNotMemIff (Filter.bind ↑f fun x => ↑(m x)) fun s => by
    simp only [mem_bind', mem_coe, ← compl_mem_iff_not_mem, compl_setOf, compl_compl]
#align ultrafilter.bind Ultrafilter.bind

instance instBind : Bind Ultrafilter :=
  ⟨@Ultrafilter.bind⟩
#align ultrafilter.has_bind Ultrafilter.instBind

instance functor : Functor Ultrafilter where map := @Ultrafilter.map
#align ultrafilter.functor Ultrafilter.functor

instance monad : Monad Ultrafilter where map := @Ultrafilter.map
#align ultrafilter.monad Ultrafilter.monad

section

attribute [local instance] Filter.monad Filter.lawfulMonad

instance lawfulMonad : LawfulMonad Ultrafilter where
  id_map f := coe_injective (id_map f.toFilter)
  pure_bind a f := coe_injective (Filter.pure_bind a ((Ultrafilter.toFilter) ∘ f))
  bind_assoc _ _ _ := coe_injective (filter_eq rfl)
  bind_pure_comp f x := coe_injective (bind_pure_comp f x.1)
  map_const := rfl
  seqLeft_eq _ _ := rfl
  seqRight_eq _ _ := rfl
  pure_seq _ _ := rfl
  bind_map _ _ := rfl
#align ultrafilter.is_lawful_monad Ultrafilter.lawfulMonad

end

/-- The ultrafilter lemma: Any proper filter is contained in an ultrafilter. -/
theorem exists_le (f : Filter α) [h : NeBot f] : ∃ u : Ultrafilter α, ↑u ≤ f :=
  let ⟨u, hu, huf⟩ := (eq_bot_or_exists_atom_le f).resolve_left h.ne
  ⟨ofAtom u hu, huf⟩
#align ultrafilter.exists_le Ultrafilter.exists_le

alias exists_le ← _root_.Filter.exists_ultrafilter_le
#align filter.exists_ultrafilter_le Filter.exists_ultrafilter_le

/-- Construct an ultrafilter extending a given filter.
  The ultrafilter lemma is the assertion that such a filter exists;
  we use the axiom of choice to pick one. -/
noncomputable def of (f : Filter α) [NeBot f] : Ultrafilter α :=
  Classical.choose (exists_le f)
#align ultrafilter.of Ultrafilter.of

theorem of_le (f : Filter α) [NeBot f] : ↑(of f) ≤ f :=
  Classical.choose_spec (exists_le f)
#align ultrafilter.of_le Ultrafilter.of_le

theorem of_coe (f : Ultrafilter α) : of ↑f = f :=
  coe_inj.1 <| f.unique (of_le f.toFilter)
#align ultrafilter.of_coe Ultrafilter.of_coe

theorem exists_ultrafilter_of_finite_inter_nonempty (S : Set (Set α))
    (cond : ∀ T : Finset (Set α), (↑T : Set (Set α)) ⊆ S → (⋂₀ (↑T : Set (Set α))).Nonempty) :
    ∃ F : Ultrafilter α, S ⊆ F.sets :=
  haveI : NeBot (generate S) :=
    generate_neBot_iff.2 fun _ hts ht =>
      ht.coe_toFinset ▸ cond ht.toFinset (ht.coe_toFinset.symm ▸ hts)
  ⟨of (generate S), fun _ ht => (of_le <| generate S) <| GenerateSets.basic ht⟩
#align ultrafilter.exists_ultrafilter_of_finite_inter_nonempty
  Ultrafilter.exists_ultrafilter_of_finite_inter_nonempty

end Ultrafilter

namespace Filter

variable {f : Filter α} {s : Set α} {a : α}

open Ultrafilter

theorem isAtom_pure : IsAtom (pure a : Filter α) :=
  (pure a : Ultrafilter α).isAtom
#align filter.is_atom_pure Filter.isAtom_pure

protected theorem NeBot.le_pure_iff (hf : f.NeBot) : f ≤ pure a ↔ f = pure a :=
  ⟨Ultrafilter.unique (pure a), le_of_eq⟩
#align filter.ne_bot.le_pure_iff Filter.NeBot.le_pure_iff

@[simp]
theorem lt_pure_iff : f < pure a ↔ f = ⊥ :=
  isAtom_pure.lt_iff
#align filter.lt_pure_iff Filter.lt_pure_iff

theorem le_pure_iff' : f ≤ pure a ↔ f = ⊥ ∨ f = pure a :=
  isAtom_pure.le_iff
#align filter.le_pure_iff' Filter.le_pure_iff'

@[simp]
theorem Iic_pure (a : α) : Iic (pure a : Filter α) = {⊥, pure a} :=
  isAtom_pure.Iic_eq
#align filter.Iic_pure Filter.Iic_pure

theorem mem_iff_ultrafilter : s ∈ f ↔ ∀ g : Ultrafilter α, ↑g ≤ f → s ∈ g := by
  refine' ⟨fun hf g hg => hg hf, fun H => by_contra fun hf => _⟩
  set g : Filter (sᶜ : Set α) := comap (↑) f
  haveI : NeBot g := comap_neBot_iff_compl_range.2 (by simpa [compl_setOf] )
  simpa using H ((of g).map (↑)) (map_le_iff_le_comap.mpr (of_le g))
#align filter.mem_iff_ultrafilter Filter.mem_iff_ultrafilter

theorem le_iff_ultrafilter {f₁ f₂ : Filter α} : f₁ ≤ f₂ ↔ ∀ g : Ultrafilter α, ↑g ≤ f₁ → ↑g ≤ f₂ :=
  ⟨fun h _ h₁ => h₁.trans h, fun h _ hs => mem_iff_ultrafilter.2 fun g hg => h g hg hs⟩
#align filter.le_iff_ultrafilter Filter.le_iff_ultrafilter

/-- A filter equals the intersection of all the ultrafilters which contain it. -/
theorem supᵢ_ultrafilter_le_eq (f : Filter α) :
    (⨆ (g : Ultrafilter α) (_hg : g ≤ f), (g : Filter α)) = f :=
  eq_of_forall_ge_iff fun f' => by simp only [supᵢ_le_iff, ← le_iff_ultrafilter]
#align filter.supr_ultrafilter_le_eq Filter.supᵢ_ultrafilter_le_eq

/-- The `tendsto` relation can be checked on ultrafilters. -/
theorem tendsto_iff_ultrafilter (f : α → β) (l₁ : Filter α) (l₂ : Filter β) :
    Tendsto f l₁ l₂ ↔ ∀ g : Ultrafilter α, ↑g ≤ l₁ → Tendsto f g l₂ := by
  simpa only [tendsto_iff_comap] using le_iff_ultrafilter
#align filter.tendsto_iff_ultrafilter Filter.tendsto_iff_ultrafilter

theorem exists_ultrafilter_iff {f : Filter α} : (∃ u : Ultrafilter α, ↑u ≤ f) ↔ NeBot f :=
  ⟨fun ⟨_, uf⟩ => neBot_of_le uf, fun h => @exists_ultrafilter_le _ _ h⟩
#align filter.exists_ultrafilter_iff Filter.exists_ultrafilter_iff

theorem forall_neBot_le_iff {g : Filter α} {p : Filter α → Prop} (hp : Monotone p) :
    (∀ f : Filter α, NeBot f → f ≤ g → p f) ↔ ∀ f : Ultrafilter α, ↑f ≤ g → p f := by
  refine' ⟨fun H f hf => H f f.neBot hf, _⟩
  intro H f hf hfg
  exact hp (of_le f) (H _ ((of_le f).trans hfg))
#align filter.forall_ne_bot_le_iff Filter.forall_neBot_le_iff

section Hyperfilter

variable (α) [Infinite α]

/-- The ultrafilter extending the cofinite filter. -/
noncomputable def hyperfilter : Ultrafilter α :=
  Ultrafilter.of cofinite
#align filter.hyperfilter Filter.hyperfilter

variable {α}

theorem hyperfilter_le_cofinite : ↑(hyperfilter α) ≤ @cofinite α :=
  Ultrafilter.of_le cofinite
#align filter.hyperfilter_le_cofinite Filter.hyperfilter_le_cofinite

@[simp]
theorem bot_ne_hyperfilter : (⊥ : Filter α) ≠ hyperfilter α :=
  (NeBot.ne inferInstance).symm

#align filter.bot_ne_hyperfilter Filter.bot_ne_hyperfilter

theorem nmem_hyperfilter_of_finite {s : Set α} (hf : s.Finite) : s ∉ hyperfilter α := fun hy =>
  compl_not_mem hy <| hyperfilter_le_cofinite hf.compl_mem_cofinite
#align filter.nmem_hyperfilter_of_finite Filter.nmem_hyperfilter_of_finite

alias nmem_hyperfilter_of_finite ← _root_.Set.Finite.nmem_hyperfilter
#align set.finite.nmem_hyperfilter Set.Finite.nmem_hyperfilter

theorem compl_mem_hyperfilter_of_finite {s : Set α} (hf : Set.Finite s) : sᶜ ∈ hyperfilter α :=
  compl_mem_iff_not_mem.2 hf.nmem_hyperfilter
#align filter.compl_mem_hyperfilter_of_finite Filter.compl_mem_hyperfilter_of_finite

alias compl_mem_hyperfilter_of_finite ← _root_.Set.Finite.compl_mem_hyperfilter
#align set.finite.compl_mem_hyperfilter Set.Finite.compl_mem_hyperfilter

theorem mem_hyperfilter_of_finite_compl {s : Set α} (hf : Set.Finite (sᶜ)) : s ∈ hyperfilter α :=
  compl_compl s ▸ hf.compl_mem_hyperfilter
#align filter.mem_hyperfilter_of_finite_compl Filter.mem_hyperfilter_of_finite_compl

end Hyperfilter

end Filter

namespace Ultrafilter

open Filter

variable {m : α → β} {s : Set α} {g : Ultrafilter β}

/-- Ultrafilter extending the inf of a comapped ultrafilter and a principal ultrafilter. -/
noncomputable def ofComapInfPrincipal (h : m '' s ∈ g) : Ultrafilter α :=
  @of _ (Filter.comap m g ⊓ 𝓟 s) (comap_inf_principal_neBot_of_image_mem h)
#align ultrafilter.of_comap_inf_principal Ultrafilter.ofComapInfPrincipal

theorem ofComapInfPrincipal_mem (h : m '' s ∈ g) : s ∈ ofComapInfPrincipal h := by
  let f := Filter.comap m g ⊓ 𝓟 s
  haveI : f.NeBot := comap_inf_principal_neBot_of_image_mem h
  have : s ∈ f := mem_inf_of_right (mem_principal_self s)
  exact le_def.mp (of_le _) s this
#align ultrafilter.of_comap_inf_principal_mem Ultrafilter.ofComapInfPrincipal_mem

theorem ofComapInfPrincipal_eq_of_map (h : m '' s ∈ g) : (ofComapInfPrincipal h).map m = g := by
  let f := Filter.comap m g ⊓ 𝓟 s
  haveI : f.NeBot := comap_inf_principal_neBot_of_image_mem h
  apply eq_of_le
  calc
    Filter.map m (of f) ≤ Filter.map m f := map_mono (of_le _)
    _ ≤ (Filter.map m <| Filter.comap m g) ⊓ Filter.map m (𝓟 s) := map_inf_le
    _ = (Filter.map m <| Filter.comap m g) ⊓ (𝓟 <| m '' s) := by rw [map_principal]
    _ ≤ ↑g ⊓ (𝓟 <| m '' s) := inf_le_inf_right _ map_comap_le
    _ = ↑g := inf_of_le_left (le_principal_iff.mpr h)

#align ultrafilter.of_comap_inf_principal_eq_of_map Ultrafilter.ofComapInfPrincipal_eq_of_map

end Ultrafilter


import rescale.pseudo_normed_group
import pseudo_normed_group.LC

open_locale classical nnreal
open opposite ProFiltPseuNormGrpWithTinv

open SemiNormedGroup opposite Profinite pseudo_normed_group category_theory breen_deligne
open profinitely_filtered_pseudo_normed_group

universe variable u
variables (r : ℝ≥0) (V : SemiNormedGroup) (r' : ℝ≥0) [fact (0 < r')]
variables (c c₁ c₂ c₃ c₄ : ℝ≥0) (l m n : ℕ)

@[simp] theorem LCFP_rescale (N : ℝ≥0)
  (M) [profinitely_filtered_pseudo_normed_group_with_Tinv r' M] :
  (LCFP V r' c n).obj (op (of r' (rescale N M))) =
  (LCFP V r' (c * N⁻¹) n).obj (op (of r' M)) := rfl

namespace breen_deligne

namespace basic_universal_map

variables (ϕ : basic_universal_map m n)

theorem eval_FP_rescale [ϕ.suitable c₁ c₂]
  (N : ℝ≥0) (M) [profinitely_filtered_pseudo_normed_group_with_Tinv r' M] :
  (eval_FP r' c₁ c₂ ϕ).app (of r' (rescale N M)) =
  ((eval_FP r' (c₁ * N⁻¹) (c₂ * N⁻¹) ϕ).app (of r' M)) :=
begin
  ext x i, dsimp only [eval_FP, continuous_map.coe_mk, eval_png₀, subtype.coe_mk],
  simp only [eval_png_apply]
end

theorem eval_LCFP_rescale [ϕ.suitable c₂ c₁]
  (N : ℝ≥0) (M) [profinitely_filtered_pseudo_normed_group_with_Tinv r' M] :
  (eval_LCFP V r' ϕ c₁ c₂).app (op (of r' (rescale N M))) =
  by clean @_root_.id _ ((eval_LCFP V r' ϕ (c₁ * N⁻¹) (c₂ * N⁻¹)).app (op (of r' M))) :=
begin
  dsimp only [eval_LCFP, whisker_right_app, nat_trans.op_app, unop_op],
  rw eval_FP_rescale
end

end basic_universal_map

namespace universal_map

variables (ϕ : universal_map m n)

theorem eval_LCFP_rescale [ϕ.suitable c₂ c₁]
  (N : ℝ≥0)
  (M) [profinitely_filtered_pseudo_normed_group_with_Tinv r' M] :
  (eval_LCFP V r' c₁ c₂ ϕ).app (op (of r' (rescale N M))) =
  (by clean @_root_.id _ ((eval_LCFP V r' (c₁ * N⁻¹) (c₂ * N⁻¹) ϕ).app (op (of r' M)))) :=
begin
  simp only [eval_LCFP, ← nat_trans.app_hom_apply,
    add_monoid_hom.map_sum, add_monoid_hom.map_zsmul],
  simp only [nat_trans.app_hom_apply, basic_universal_map.eval_LCFP_rescale],
end

end universal_map

end breen_deligne


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

import category_theory.idempotents.karoubi

/-!
# Idempotent completeness and functor categories

In this file we define an instance `functor_category_is_idempotent_complete` expressing
that a functor category `J ⥤ C` is idempotent complete when the target category `C` is.

We also provide a fully faithful functor
`karoubi_functor_category_embedding : karoubi (J ⥤ C)) : J ⥤ karoubi C` for all categories
`J` and `C`.

-/

open category_theory
open category_theory.category
open category_theory.idempotents.karoubi
open category_theory.limits

namespace category_theory

namespace idempotents

variables {J C : Type*} [category J] [category C] (P Q : karoubi (J ⥤ C)) (f : P ⟶ Q) (X : J)

@[simp, reassoc]
lemma app_idem :
  P.p.app X ≫ P.p.app X = P.p.app X := congr_app P.idem X

variables {P Q}

@[simp, reassoc]
lemma app_p_comp : P.p.app X ≫ f.f.app X = f.f.app X := congr_app (p_comp f) X

@[simp, reassoc]
lemma app_comp_p : f.f.app X ≫ Q.p.app X = f.f.app X := congr_app (comp_p f) X

@[reassoc]
lemma app_p_comm : P.p.app X ≫ f.f.app X = f.f.app X ≫ Q.p.app X := congr_app (p_comm f) X

variables (J C)

instance functor_category_is_idempotent_complete [is_idempotent_complete C] :
  is_idempotent_complete (J ⥤ C) :=
begin
  refine ⟨_⟩,
  intros F p hp,
  have hC := (is_idempotent_complete_iff_has_equalizer_of_id_and_idempotent C).mp infer_instance,
  haveI : ∀ (j : J), has_equalizer (𝟙 _) (p.app j) := λ j, hC _ _ (congr_app hp j),
  /- We construct the direct factor `Y` associated to `p : F ⟶ F` by computing
    the equalizer of the identity and `p.app j` on each object `(j : J)`.  -/
  let Y : J ⥤ C :=
  { obj := λ j, limits.equalizer (𝟙 _) (p.app j),
    map := λ j j' φ, equalizer.lift (limits.equalizer.ι (𝟙 _) (p.app j) ≫ F.map φ)
      (by rw [comp_id, assoc, p.naturality φ, ← assoc, ← limits.equalizer.condition, comp_id]),
    map_id' := λ j, by { ext, simp only [comp_id, functor.map_id, equalizer.lift_ι, id_comp], },
    map_comp' := λ j j' j'' φ φ', begin
      ext,
      simp only [assoc, functor.map_comp, equalizer.lift_ι, equalizer.lift_ι_assoc],
    end },
  let i : Y ⟶ F :=
  { app := λ j, equalizer.ι _ _,
    naturality' := λ j j' φ, by rw [equalizer.lift_ι],  },
  let e : F ⟶ Y :=
  { app := λ j, equalizer.lift (p.app j)
      (by { rw comp_id, exact (congr_app hp j).symm, }),
    naturality' := λ j j' φ, begin
      ext,
      simp only [assoc, equalizer.lift_ι, nat_trans.naturality, equalizer.lift_ι_assoc],
    end },
  use [Y, i, e],
  split; ext j,
  { simp only [nat_trans.comp_app, assoc, equalizer.lift_ι, nat_trans.id_app, id_comp,
      ← equalizer.condition, comp_id], },
  { simp only [nat_trans.comp_app, equalizer.lift_ι], },
end

namespace karoubi_functor_category_embedding

variables {J C}

/-- On objects, the functor which sends a formal direct factor `P` of a
functor `F : J ⥤ C` to the functor `J ⥤ karoubi C` which sends `(j : J)` to
the corresponding direct factor of `F.obj j`. -/
@[simps]
def obj (P : karoubi (J ⥤ C)) : J ⥤ karoubi C :=
{ obj := λ j, ⟨P.X.obj j, P.p.app j, congr_app P.idem j⟩,
  map := λ j j' φ,
  { f := P.p.app j ≫ P.X.map φ,
    comm := begin
      simp only [nat_trans.naturality, assoc],
      have h := congr_app P.idem j,
      rw [nat_trans.comp_app] at h,
      slice_rhs 1 3 { erw [h, h], },
    end }, }

/-- Tautological action on maps of the functor `karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C)`. -/
@[simps]
def map {P Q : karoubi (J ⥤ C)} (f : P ⟶ Q) : obj P ⟶ obj Q :=
{ app := λ j, ⟨f.f.app j, congr_app f.comm j⟩, }

end karoubi_functor_category_embedding

variables (J C)

/-- The tautological fully faithful functor `karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C)`. -/
@[simps]
def karoubi_functor_category_embedding :
  karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C) :=
{ obj := karoubi_functor_category_embedding.obj,
  map := λ P Q, karoubi_functor_category_embedding.map, }

instance : full (karoubi_functor_category_embedding J C) :=
{ preimage := λ P Q f,
  { f :=
    { app := λ j, (f.app j).f,
      naturality' := λ j j' φ, begin
        rw ← karoubi.comp_p_assoc,
        have h := hom_ext.mp (f.naturality φ),
        simp only [comp_f] at h,
        dsimp [karoubi_functor_category_embedding] at h,
        erw [← h, assoc, ← P.p.naturality_assoc φ, p_comp (f.app j')],
      end },
    comm := by { ext j, exact (f.app j).comm, } },
  witness' := λ P Q f, by { ext j, refl, }, }

instance : faithful (karoubi_functor_category_embedding J C) :=
{ map_injective' := λ P Q f f' h, by { ext j, exact hom_ext.mp (congr_app h j), }, }

/-- The composition of `(J ⥤ C) ⥤ karoubi (J ⥤ C)` and `karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C)`
equals the functor `(J ⥤ C) ⥤ (J ⥤ karoubi C)` given by the composition with
`to_karoubi C : C ⥤ karoubi C`. -/
lemma to_karoubi_comp_karoubi_functor_category_embedding :
  (to_karoubi _) ⋙ karoubi_functor_category_embedding J C =
  (whiskering_right J _ _).obj (to_karoubi C) :=
begin
  apply functor.ext,
  { intros X Y f,
    ext j,
    dsimp [to_karoubi],
    simp only [eq_to_hom_app, eq_to_hom_refl, id_comp],
    erw [comp_id], },
  { intro X,
    apply functor.ext,
    { intros j j' φ,
      ext,
      dsimp,
      simpa only [comp_id, id_comp], },
    { intro j,
      refl, }, }
end

end idempotents

end category_theory


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Seul Baek
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.omega.clause
import Mathlib.PostPort

namespace Mathlib

/-
Linear combination of constraints.
-/

namespace omega

/-- Linear combination of constraints. The second
    argument is the list of constraints, and the first
    argument is the list of conefficients by which the
    constraints are multiplied -/
@[simp] def lin_comb : List ℕ → List term → term := sorry

theorem lin_comb_holds {v : ℕ → ℤ} {ts : List term} (ns : List ℕ) :
    (∀ (t : term), t ∈ ts → 0 ≤ term.val v t) → 0 ≤ term.val v (lin_comb ns ts) :=
  sorry

/-- `unsat_lin_comb ns ts` asserts that the linear combination
    `lin_comb ns ts` is unsatisfiable  -/
def unsat_lin_comb (ns : List ℕ) (ts : List term) :=
  prod.fst (lin_comb ns ts) < 0 ∧ ∀ (x : ℤ), x ∈ prod.snd (lin_comb ns ts) → x = 0

theorem unsat_lin_comb_of (ns : List ℕ) (ts : List term) :
    prod.fst (lin_comb ns ts) < 0 →
        (∀ (x : ℤ), x ∈ prod.snd (lin_comb ns ts) → x = 0) → unsat_lin_comb ns ts :=
  fun (h1 : prod.fst (lin_comb ns ts) < 0)
    (h2 : ∀ (x : ℤ), x ∈ prod.snd (lin_comb ns ts) → x = 0) => { left := h1, right := h2 }

theorem unsat_of_unsat_lin_comb (ns : List ℕ) (ts : List term) :
    unsat_lin_comb ns ts → clause.unsat ([], ts) :=
  sorry

end Mathlib


/- Very unfinished, Will finish by end of term -/

import data.rat.basic
import data.nat.prime
import data.real.basic

open nat algebra

variables a b : ℕ
variable x : ℝ

def root2 (x : ℝ) := (x^2 = 2)
def is_rat (x : ℝ) Prop := ∃ a : ℕ ∃ b : ℤ, x = a / b

/-
theorem root2_irrat (rt : root2 x) (a b : ℕ):  ¬ is_rat x :=
assume is_rat x,
exists.elim h (fun (a b: ℕ) (hw1 : x = a / b),
  begin
    sorry
  end
)
-/

def even (n : ℕ) : Prop := ∃ m, n = 2 * m
def odd (n : ℕ) : Prop := ∃ m, n = 2 * m + 1

lemma not_even_and_odd (n : ℕ) : ¬((even n) ∧ (odd n)) :=
sorry

lemma not_even_and_odd (n : ℕ) : ¬((even n) ∧ (odd n)) :=
assume (h : even n ∧ odd n),
have he: even n, from h.left,
have ho: odd n, from h.right,
have ev: ∃ m, n = 2 * m, from he,
have od: ∃ m, n = 2 * m + 1, from ho,

exists.elim ev (fun (m1 : ℕ) (h1 : n = 2 * m1),
exists.elim od (fun (m2 : ℕ) (h2 : n = 2 * m2 + 1),
begin
eq.trans (eq.symm h1) h2

end
))

lemma even_square_even_root {n m: ℕ} (n = m^2) (e: even n) : even m :=
exists.elim e (assume m1, assume hw1 : n = 2 * m1,
begin
/- Requires prime number theory or claim that not even = odd-/
sorry
end)

theorem root2_irrat {a b asq bsq : ℕ} (gcd_1 : gcd a b = 1) (p: asq = a^2) (q: bsq = b^2): asq ≠ 2 * bsq :=
assume (h : asq = 2 * bsq),
have evasq : even asq :=
begin
  rw even,
  /- exists.elim bsq  -/
  sorry
end,
have eva : even a :=
begin
/- apply even_square_even_root asq p -/
sorry
end,


/-
Copyright (c) 2017 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pfunctor.univariate.basic
import Mathlib.PostPort

universes u l w u_1

namespace Mathlib

/-!
# M-types

M types are potentially infinite tree-like structures. They are defined
as the greatest fixpoint of a polynomial functor.
-/

namespace pfunctor

namespace approx

/-- `cofix_a F n` is an `n` level approximation of a M-type -/
inductive cofix_a (F : pfunctor) : ℕ → Type u where
| continue : cofix_a F 0
| intro : {n : ℕ} → (a : A F) → (B F a → cofix_a F n) → cofix_a F (Nat.succ n)

/-- default inhabitant of `cofix_a` -/
protected def cofix_a.default (F : pfunctor) [Inhabited (A F)] (n : ℕ) : cofix_a F n := sorry

protected instance cofix_a.inhabited (F : pfunctor) [Inhabited (A F)] {n : ℕ} :
    Inhabited (cofix_a F n) :=
  { default := cofix_a.default F n }

theorem cofix_a_eq_zero (F : pfunctor) (x : cofix_a F 0) (y : cofix_a F 0) : x = y := sorry

/--
The label of the root of the tree for a non-trivial
approximation of the cofix of a pfunctor.
-/
def head' {F : pfunctor} {n : ℕ} : cofix_a F (Nat.succ n) → A F := sorry

/-- for a non-trivial approximation, return all the subtrees of the root -/
def children' {F : pfunctor} {n : ℕ} (x : cofix_a F (Nat.succ n)) : B F (head' x) → cofix_a F n :=
  sorry

theorem approx_eta {F : pfunctor} {n : ℕ} (x : cofix_a F (n + 1)) :
    x = cofix_a.intro (head' x) (children' x) :=
  sorry

/-- Relation between two approximations of the cofix of a pfunctor that state they both contain the same
data until one of them is truncated -/
inductive agree {F : pfunctor} : {n : ℕ} → cofix_a F n → cofix_a F (n + 1) → Prop where
| continue : ∀ (x : cofix_a F 0) (y : cofix_a F 1), agree x y
| intro :
    ∀ {n : ℕ} {a : A F} (x : B F a → cofix_a F n) (x' : B F a → cofix_a F (n + 1)),
      (∀ (i : B F a), agree (x i) (x' i)) → agree (cofix_a.intro a x) (cofix_a.intro a x')

/--
Given an infinite series of approximations `approx`,
`all_agree approx` states that they are all consistent with each other.
-/
def all_agree {F : pfunctor} (x : (n : ℕ) → cofix_a F n) := ∀ (n : ℕ), agree (x n) (x (Nat.succ n))

@[simp] theorem agree_trival {F : pfunctor} {x : cofix_a F 0} {y : cofix_a F 1} : agree x y :=
  agree.continue x y

theorem agree_children {F : pfunctor} {n : ℕ} (x : cofix_a F (Nat.succ n))
    (y : cofix_a F (Nat.succ n + 1)) {i : B F (head' x)} {j : B F (head' y)} (h₀ : i == j)
    (h₁ : agree x y) : agree (children' x i) (children' y j) :=
  sorry

/-- `truncate a` turns `a` into a more limited approximation -/
def truncate {F : pfunctor} {n : ℕ} : cofix_a F (n + 1) → cofix_a F n := sorry

theorem truncate_eq_of_agree {F : pfunctor} {n : ℕ} (x : cofix_a F n) (y : cofix_a F (Nat.succ n))
    (h : agree x y) : truncate y = x :=
  sorry

/-- `s_corec f i n` creates an approximation of height `n`
of the final coalgebra of `f` -/
def s_corec {F : pfunctor} {X : Type w} (f : X → obj F X) (i : X) (n : ℕ) : cofix_a F n := sorry

theorem P_corec {F : pfunctor} {X : Type w} (f : X → obj F X) (i : X) (n : ℕ) :
    agree (s_corec f i n) (s_corec f i (Nat.succ n)) :=
  sorry

/-- `path F` provides indices to access internal nodes in `corec F` -/
def path (F : pfunctor) := List (Idx F)

protected instance path.inhabited {F : pfunctor} : Inhabited (path F) := { default := [] }

protected instance cofix_a.subsingleton {F : pfunctor} : subsingleton (cofix_a F 0) :=
  subsingleton.intro
    fun (a b : cofix_a F 0) =>
      cofix_a.cases_on a
        (fun (a_1 : 0 = 0) (H_2 : a == cofix_a.continue) =>
          Eq._oldrec
            (cofix_a.cases_on b
              (fun (a : 0 = 0) (H_2 : b == cofix_a.continue) =>
                Eq._oldrec (Eq.refl cofix_a.continue) (Eq.symm (eq_of_heq H_2)))
              (fun {b_n : ℕ} (b_a : A F) (b_ᾰ : B F b_a → cofix_a F b_n) (a : 0 = Nat.succ b_n) =>
                nat.no_confusion a)
              (Eq.refl 0) (HEq.refl b))
            (Eq.symm (eq_of_heq H_2)))
        (fun {a_n : ℕ} (a_a : A F) (a_ᾰ : B F a_a → cofix_a F a_n) (a_1 : 0 = Nat.succ a_n) =>
          nat.no_confusion a_1)
        (Eq.refl 0) (HEq.refl a)

theorem head_succ' {F : pfunctor} (n : ℕ) (m : ℕ) (x : (n : ℕ) → cofix_a F n)
    (Hconsistent : all_agree x) : head' (x (Nat.succ n)) = head' (x (Nat.succ m)) :=
  sorry

end approx

/-- Internal definition for `M`. It is needed to avoid name clashes
between `M.mk` and `M.cases_on` and the declarations generated for
the structure -/
structure M_intl (F : pfunctor) where
  approx : (n : ℕ) → approx.cofix_a F n
  consistent : approx.all_agree approx

/-- For polynomial functor `F`, `M F` is its final coalgebra -/
def M (F : pfunctor) := M_intl F

theorem M.default_consistent (F : pfunctor) [Inhabited (A F)] (n : ℕ) :
    approx.agree Inhabited.default Inhabited.default :=
  sorry

protected instance M.inhabited (F : pfunctor) [Inhabited (A F)] : Inhabited (M F) :=
  { default := M_intl.mk (fun (n : ℕ) => Inhabited.default) (M.default_consistent F) }

protected instance M_intl.inhabited (F : pfunctor) [Inhabited (A F)] : Inhabited (M_intl F) :=
  (fun (this : Inhabited (M F)) => this) (M.inhabited F)

namespace M

theorem ext' (F : pfunctor) (x : M F) (y : M F)
    (H : ∀ (i : ℕ), M_intl.approx x i = M_intl.approx y i) : x = y :=
  sorry

/-- Corecursor for the M-type defined by `F`. -/
protected def corec {F : pfunctor} {X : Type u_1} (f : X → obj F X) (i : X) : M F :=
  M_intl.mk (approx.s_corec f i) (approx.P_corec f i)

/-- given a tree generated by `F`, `head` gives us the first piece of data
it contains -/
def head {F : pfunctor} (x : M F) : A F := approx.head' (M_intl.approx x 1)

/-- return all the subtrees of the root of a tree `x : M F` -/
def children {F : pfunctor} (x : M F) (i : B F (head x)) : M F :=
  M_intl.mk (fun (n : ℕ) => approx.children' (M_intl.approx x (Nat.succ n)) (cast sorry i)) sorry

/-- select a subtree using a `i : F.Idx` or return an arbitrary tree if
`i` designates no subtree of `x` -/
def ichildren {F : pfunctor} [Inhabited (M F)] [DecidableEq (A F)] (i : Idx F) (x : M F) : M F :=
  dite (sigma.fst i = head x)
    (fun (H' : sigma.fst i = head x) => children x (cast sorry (sigma.snd i)))
    fun (H' : ¬sigma.fst i = head x) => Inhabited.default

theorem head_succ {F : pfunctor} (n : ℕ) (m : ℕ) (x : M F) :
    approx.head' (M_intl.approx x (Nat.succ n)) = approx.head' (M_intl.approx x (Nat.succ m)) :=
  approx.head_succ' n m (M_intl.approx x) (M_intl.consistent x)

theorem head_eq_head' {F : pfunctor} (x : M F) (n : ℕ) :
    head x = approx.head' (M_intl.approx x (n + 1)) :=
  sorry

theorem head'_eq_head {F : pfunctor} (x : M F) (n : ℕ) :
    approx.head' (M_intl.approx x (n + 1)) = head x :=
  sorry

theorem truncate_approx {F : pfunctor} (x : M F) (n : ℕ) :
    approx.truncate (M_intl.approx x (n + 1)) = M_intl.approx x n :=
  approx.truncate_eq_of_agree (M_intl.approx x n) (M_intl.approx x (n + 1)) (M_intl.consistent x n)

/-- unfold an M-type -/
def dest {F : pfunctor} : M F → obj F (M F) := sorry

namespace approx

/-- generates the approximations needed for `M.mk` -/
protected def s_mk {F : pfunctor} (x : obj F (M F)) (n : ℕ) : approx.cofix_a F n := sorry

protected theorem P_mk {F : pfunctor} (x : obj F (M F)) : approx.all_agree (approx.s_mk x) := sorry

end approx

/-- constructor for M-types -/
protected def mk {F : pfunctor} (x : obj F (M F)) : M F := M_intl.mk (approx.s_mk x) (approx.P_mk x)

/-- `agree' n` relates two trees of type `M F` that
are the same up to dept `n` -/
inductive agree' {F : pfunctor} : ℕ → M F → M F → Prop where
| trivial : ∀ (x y : M F), agree' 0 x y
| step :
    ∀ {n : ℕ} {a : A F} (x y : B F a → M F) {x' y' : M F},
      x' = M.mk (sigma.mk a x) →
        y' = M.mk (sigma.mk a y) → (∀ (i : B F a), agree' n (x i) (y i)) → agree' (Nat.succ n) x' y'

@[simp] theorem dest_mk {F : pfunctor} (x : obj F (M F)) : dest (M.mk x) = x := sorry

@[simp] theorem mk_dest {F : pfunctor} (x : M F) : M.mk (dest x) = x := sorry

theorem mk_inj {F : pfunctor} {x : obj F (M F)} {y : obj F (M F)} (h : M.mk x = M.mk y) : x = y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x = y)) (Eq.symm (dest_mk x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (dest (M.mk x) = y)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (dest (M.mk y) = y)) (dest_mk y))) (Eq.refl y)))

/-- destructor for M-types -/
protected def cases {F : pfunctor} {r : M F → Sort w} (f : (x : obj F (M F)) → r (M.mk x))
    (x : M F) : r x :=
  (fun (this : r (M.mk (dest x))) => eq.mpr sorry this) (f (dest x))

/-- destructor for M-types -/
protected def cases_on {F : pfunctor} {r : M F → Sort w} (x : M F)
    (f : (x : obj F (M F)) → r (M.mk x)) : r x :=
  M.cases f x

/-- destructor for M-types, similar to `cases_on` but also
gives access directly to the root and subtrees on an M-type -/
protected def cases_on' {F : pfunctor} {r : M F → Sort w} (x : M F)
    (f : (a : A F) → (f : B F a → M F) → r (M.mk (sigma.mk a f))) : r x :=
  M.cases_on x fun (_x : obj F (M F)) => sorry

theorem approx_mk {F : pfunctor} (a : A F) (f : B F a → M F) (i : ℕ) :
    M_intl.approx (M.mk (sigma.mk a f)) (Nat.succ i) =
        approx.cofix_a.intro a fun (j : B F a) => M_intl.approx (f j) i :=
  rfl

@[simp] theorem agree'_refl {F : pfunctor} {n : ℕ} (x : M F) : agree' n x x := sorry

theorem agree_iff_agree' {F : pfunctor} {n : ℕ} (x : M F) (y : M F) :
    approx.agree (M_intl.approx x n) (M_intl.approx y (n + 1)) ↔ agree' n x y :=
  sorry

@[simp] theorem cases_mk {F : pfunctor} {r : M F → Sort u_1} (x : obj F (M F))
    (f : (x : obj F (M F)) → r (M.mk x)) : M.cases f (M.mk x) = f x :=
  sorry

@[simp] theorem cases_on_mk {F : pfunctor} {r : M F → Sort u_1} (x : obj F (M F))
    (f : (x : obj F (M F)) → r (M.mk x)) : M.cases_on (M.mk x) f = f x :=
  cases_mk x f

@[simp] theorem cases_on_mk' {F : pfunctor} {r : M F → Sort u_1} {a : A F} (x : B F a → M F)
    (f : (a : A F) → (f : B F a → M F) → r (M.mk (sigma.mk a f))) :
    M.cases_on' (M.mk (sigma.mk a x)) f = f a x :=
  cases_mk (sigma.mk a x) fun (_x : obj F (M F)) => cases_on'._match_1 f _x

/-- `is_path p x` tells us if `p` is a valid path through `x` -/
inductive is_path {F : pfunctor} : approx.path F → M F → Prop where
| nil : ∀ (x : M F), is_path [] x
| cons :
    ∀ (xs : approx.path F) {a : A F} (x : M F) (f : B F a → M F) (i : B F a),
      x = M.mk (sigma.mk a f) → is_path xs (f i) → is_path (sigma.mk a i :: xs) x

theorem is_path_cons {F : pfunctor} {xs : approx.path F} {a : A F} {a' : A F} {f : B F a → M F}
    {i : B F a'} (h : is_path (sigma.mk a' i :: xs) (M.mk (sigma.mk a f))) : a = a' :=
  sorry

theorem is_path_cons' {F : pfunctor} {xs : approx.path F} {a : A F} {f : B F a → M F} {i : B F a}
    (h : is_path (sigma.mk a i :: xs) (M.mk (sigma.mk a f))) : is_path xs (f i) :=
  sorry

/-- follow a path through a value of `M F` and return the subtree
found at the end of the path if it is a valid path for that value and
return a default tree -/
def isubtree {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)] : approx.path F → M F → M F :=
  sorry

/-- similar to `isubtree` but returns the data at the end of the path instead
of the whole subtree -/
def iselect {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)] (ps : approx.path F) : M F → A F :=
  fun (x : M F) => head (isubtree ps x)

theorem iselect_eq_default {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)] (ps : approx.path F)
    (x : M F) (h : ¬is_path ps x) : iselect ps x = head Inhabited.default :=
  sorry

@[simp] theorem head_mk {F : pfunctor} (x : obj F (M F)) : head (M.mk x) = sigma.fst x := sorry

theorem children_mk {F : pfunctor} {a : A F} (x : B F a → M F)
    (i : B F (head (M.mk (sigma.mk a x)))) :
    children (M.mk (sigma.mk a x)) i =
        x
          (cast
            (eq.mpr
              (id
                (Eq._oldrec (Eq.refl (B F (head (M.mk (sigma.mk a x))) = B F a))
                  (head_mk (sigma.mk a x))))
              (Eq.refl (B F (sigma.fst (sigma.mk a x)))))
            i) :=
  sorry

@[simp] theorem ichildren_mk {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)] (x : obj F (M F))
    (i : Idx F) : ichildren i (M.mk x) = obj.iget x i :=
  sorry

@[simp] theorem isubtree_cons {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)]
    (ps : approx.path F) {a : A F} (f : B F a → M F) {i : B F a} :
    isubtree (sigma.mk a i :: ps) (M.mk (sigma.mk a f)) = isubtree ps (f i) :=
  sorry

@[simp] theorem iselect_nil {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)] {a : A F}
    (f : B F a → M F) : iselect [] (M.mk (sigma.mk a f)) = a :=
  Eq.refl (iselect [] (M.mk (sigma.mk a f)))

@[simp] theorem iselect_cons {F : pfunctor} [DecidableEq (A F)] [Inhabited (M F)]
    (ps : approx.path F) {a : A F} (f : B F a → M F) {i : B F a} :
    iselect (sigma.mk a i :: ps) (M.mk (sigma.mk a f)) = iselect ps (f i) :=
  sorry

theorem corec_def {F : pfunctor} {X : Type u} (f : X → obj F X) (x₀ : X) :
    M.corec f x₀ = M.mk (M.corec f <$> f x₀) :=
  sorry

theorem ext_aux {F : pfunctor} [Inhabited (M F)] [DecidableEq (A F)] {n : ℕ} (x : M F) (y : M F)
    (z : M F) (hx : agree' n z x) (hy : agree' n z y)
    (hrec : ∀ (ps : approx.path F), n = list.length ps → iselect ps x = iselect ps y) :
    M_intl.approx x (n + 1) = M_intl.approx y (n + 1) :=
  sorry

theorem ext {F : pfunctor} [Inhabited (M F)] (x : M F) (y : M F)
    (H : ∀ (ps : approx.path F), iselect ps x = iselect ps y) : x = y :=
  sorry

/-- Bisimulation is the standard proof technique for equality between
infinite tree-like structures -/
structure is_bisimulation {F : pfunctor} (R : M F → M F → Prop) where
  head :
    ∀ {a a' : A F} {f : B F a → M F} {f' : B F a' → M F},
      R (M.mk (sigma.mk a f)) (M.mk (sigma.mk a' f')) → a = a'
  tail :
    ∀ {a : A F} {f f' : B F a → M F},
      R (M.mk (sigma.mk a f)) (M.mk (sigma.mk a f')) → ∀ (i : B F a), R (f i) (f' i)

theorem nth_of_bisim {F : pfunctor} (R : M F → M F → Prop) [Inhabited (M F)]
    (bisim : is_bisimulation R) (s₁ : M F) (s₂ : M F) (ps : approx.path F) :
    R s₁ s₂ →
        is_path ps s₁ ∨ is_path ps s₂ →
          iselect ps s₁ = iselect ps s₂ ∧
            ∃ (a : A F),
              ∃ (f : B F a → M F),
                ∃ (f' : B F a → M F),
                  isubtree ps s₁ = M.mk (sigma.mk a f) ∧
                    isubtree ps s₂ = M.mk (sigma.mk a f') ∧ ∀ (i : B F a), R (f i) (f' i) :=
  sorry

theorem eq_of_bisim {F : pfunctor} (R : M F → M F → Prop) [Nonempty (M F)]
    (bisim : is_bisimulation R) (s₁ : M F) (s₂ : M F) : R s₁ s₂ → s₁ = s₂ :=
  sorry

/-- corecursor for `M F` with swapped arguments -/
def corec_on {F : pfunctor} {X : Type u_1} (x₀ : X) (f : X → obj F X) : M F := M.corec f x₀

theorem dest_corec {P : pfunctor} {α : Type u} (g : α → obj P α) (x : α) :
    dest (M.corec g x) = M.corec g <$> g x :=
  sorry

theorem bisim {P : pfunctor} (R : M P → M P → Prop)
    (h :
      ∀ (x y : M P),
        R x y →
          ∃ (a : A P),
            ∃ (f : B P a → M P),
              ∃ (f' : B P a → M P),
                dest x = sigma.mk a f ∧ dest y = sigma.mk a f' ∧ ∀ (i : B P a), R (f i) (f' i))
    (x : M P) (y : M P) : R x y → x = y :=
  sorry

theorem bisim' {P : pfunctor} {α : Type u_1} (Q : α → Prop) (u : α → M P) (v : α → M P)
    (h :
      ∀ (x : α),
        Q x →
          ∃ (a : A P),
            ∃ (f : B P a → M P),
              ∃ (f' : B P a → M P),
                dest (u x) = sigma.mk a f ∧
                  dest (v x) = sigma.mk a f' ∧
                    ∀ (i : B P a), ∃ (x' : α), Q x' ∧ f i = u x' ∧ f' i = v x')
    (x : α) : Q x → u x = v x :=
  sorry

-- for the record, show M_bisim follows from _bisim'

theorem bisim_equiv {P : pfunctor} (R : M P → M P → Prop)
    (h :
      ∀ (x y : M P),
        R x y →
          ∃ (a : A P),
            ∃ (f : B P a → M P),
              ∃ (f' : B P a → M P),
                dest x = sigma.mk a f ∧ dest y = sigma.mk a f' ∧ ∀ (i : B P a), R (f i) (f' i))
    (x : M P) (y : M P) : R x y → x = y :=
  sorry

theorem corec_unique {P : pfunctor} {α : Type u} (g : α → obj P α) (f : α → M P)
    (hyp : ∀ (x : α), dest (f x) = f <$> g x) : f = M.corec g :=
  sorry

/-- corecursor where the state of the computation can be sent downstream
in the form of a recursive call -/
def corec₁ {P : pfunctor} {α : Type u} (F : (X : Type u) → (α → X) → α → obj P X) : α → M P :=
  M.corec (F α id)

/-- corecursor where it is possible to return a fully formed value at any point
of the computation -/
def corec' {P : pfunctor} {α : Type u} (F : {X : Type u} → (α → X) → α → M P ⊕ obj P X) (x : α) :
    M P :=
  corec₁
    (fun (X : Type u) (rec : M P ⊕ α → X) (a : M P ⊕ α) =>
      let y : M P ⊕ obj P X := a >>= F (rec ∘ sum.inr);
      sorry)
    (sum.inr x)

end Mathlib


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import category_theory.Fintype
import order.category.PartialOrder

/-!
# The category of finite partial orders

This defines `FinPartialOrder`, the category of finite partial orders.

Note: `FinPartialOrder` is NOT a subcategory of `BoundedOrder` because its morphisms do not
preserve `⊥` and `⊤`.

## TODO

`FinPartialOrder` is equivalent to a small category.
-/

universes u v

open category_theory

/-- The category of finite partial orders with monotone functions. -/
structure FinPartialOrder :=
(to_PartialOrder : PartialOrder)
[is_fintype : fintype to_PartialOrder]

namespace FinPartialOrder

instance : has_coe_to_sort FinPartialOrder Type* := ⟨λ X, X.to_PartialOrder⟩
instance (X : FinPartialOrder) : partial_order X := X.to_PartialOrder.str
attribute [instance]  FinPartialOrder.is_fintype

@[simp] lemma coe_to_PartialOrder (X : FinPartialOrder) : ↥X.to_PartialOrder = ↥X := rfl

/-- Construct a bundled `FinPartialOrder` from `fintype` + `partial_order`. -/
def of (α : Type*) [partial_order α] [fintype α] : FinPartialOrder := ⟨⟨α⟩⟩

@[simp] lemma coe_of (α : Type*) [partial_order α] [fintype α] : ↥(of α) = α := rfl

instance : inhabited FinPartialOrder := ⟨of punit⟩

instance large_category : large_category FinPartialOrder :=
induced_category.category FinPartialOrder.to_PartialOrder

instance concrete_category : concrete_category FinPartialOrder :=
induced_category.concrete_category FinPartialOrder.to_PartialOrder

instance has_forget_to_PartialOrder : has_forget₂ FinPartialOrder PartialOrder :=
induced_category.has_forget₂ FinPartialOrder.to_PartialOrder

instance has_forget_to_Fintype : has_forget₂ FinPartialOrder Fintype :=
{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, coe_fn } }

/-- Constructs an isomorphism of finite partial orders from an order isomorphism between them. -/
@[simps] def iso.mk {α β : FinPartialOrder.{u}} (e : α ≃o β) : α ≅ β :=
{ hom := e,
  inv := e.symm,
  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }

/-- `order_dual` as a functor. -/
@[simps] def dual : FinPartialOrder ⥤ FinPartialOrder :=
{ obj := λ X, of (order_dual X), map := λ X Y, order_hom.dual }

/-- The equivalence between `FinPartialOrder` and itself induced by `order_dual` both ways. -/
@[simps functor inverse] def dual_equiv : FinPartialOrder ≌ FinPartialOrder :=
equivalence.mk dual dual
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)

end FinPartialOrder

lemma FinPartialOrder_dual_comp_forget_to_PartialOrder :
  FinPartialOrder.dual ⋙ forget₂ FinPartialOrder PartialOrder =
    forget₂ FinPartialOrder PartialOrder ⋙ PartialOrder.dual := rfl


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.yoneda
import topology.sheaves.presheaf
import topology.category.TopCommRing
import topology.continuous_function.algebra

/-!
# Presheaves of functions

We construct some simple examples of presheaves of functions on a topological space.
* `presheaf_to_Types X T`, where `T : X → Type`,
  is the presheaf of dependently-typed (not-necessarily continuous) functions
* `presheaf_to_Type X T`, where `T : Type`,
  is the presheaf of (not-necessarily-continuous) functions to a fixed target type `T`
* `presheaf_to_Top X T`, where `T : Top`,
  is the presheaf of continuous functions into a topological space `T`
* `presheaf_To_TopCommRing X R`, where `R : TopCommRing`
  is the presheaf valued in `CommRing` of functions functions into a topological ring `R`
* as an example of the previous construction,
  `presheaf_to_TopCommRing X (TopCommRing.of ℂ)`
  is the presheaf of rings of continuous complex-valued functions on `X`.
-/

universes v u

open category_theory
open topological_space
open opposite

namespace Top

variables (X : Top.{v})

/--
The presheaf of dependently typed functions on `X`, with fibres given by a type family `T`.
There is no requirement that the functions are continuous, here.
-/
def presheaf_to_Types (T : X → Type v) : X.presheaf (Type v) :=
{ obj := λ U, Π x : (unop U), T x,
  map := λ U V i g, λ (x : unop V), g (i.unop x),
  map_id' := λ U, by { ext g ⟨x, hx⟩, refl },
  map_comp' := λ U V W i j, rfl }

@[simp] lemma presheaf_to_Types_obj
  {T : X → Type v} {U : (opens X)ᵒᵖ} :
  (presheaf_to_Types X T).obj U = Π x : (unop U), T x :=
rfl

@[simp] lemma presheaf_to_Types_map
  {T : X → Type v} {U V : (opens X)ᵒᵖ} {i : U ⟶ V} {f} :
  (presheaf_to_Types X T).map i f = λ x, f (i.unop x) :=
rfl

/--
The presheaf of functions on `X` with values in a type `T`.
There is no requirement that the functions are continuous, here.
-/
-- We don't just define this in terms of `presheaf_to_Types`,
-- as it's helpful later to see (at a syntactic level) that `(presheaf_to_Type X T).obj U`
-- is a non-dependent function.
-- We don't use `@[simps]` to generate the projection lemmas here,
-- as it turns out to be useful to have `presheaf_to_Type_map`
-- written as an equality of functions (rather than being applied to some argument).
def presheaf_to_Type (T : Type v) : X.presheaf (Type v) :=
{ obj := λ U, (unop U) → T,
  map := λ U V i g, g ∘ i.unop,
  map_id' := λ U, by { ext g ⟨x, hx⟩, refl },
  map_comp' := λ U V W i j, rfl }

@[simp] lemma presheaf_to_Type_obj
  {T : Type v} {U : (opens X)ᵒᵖ} :
  (presheaf_to_Type X T).obj U = ((unop U) → T) :=
rfl

@[simp] lemma presheaf_to_Type_map
  {T : Type v} {U V : (opens X)ᵒᵖ} {i : U ⟶ V} {f} :
  (presheaf_to_Type X T).map i f = f ∘ i.unop :=
rfl

/-- The presheaf of continuous functions on `X` with values in fixed target topological space
`T`. -/
def presheaf_to_Top (T : Top.{v}) : X.presheaf (Type v) :=
(opens.to_Top X).op ⋙ (yoneda.obj T)

@[simp] lemma presheaf_to_Top_obj (T : Top.{v}) (U : (opens X)ᵒᵖ) :
  (presheaf_to_Top X T).obj U = ((opens.to_Top X).obj (unop U) ⟶ T) :=
rfl

/-- The (bundled) commutative ring of continuous functions from a topological space
to a topological commutative ring, with pointwise multiplication. -/
-- TODO upgrade the result to TopCommRing?
def continuous_functions (X : Top.{v}ᵒᵖ) (R : TopCommRing.{v}) : CommRing.{v} :=
CommRing.of (unop X ⟶ (forget₂ TopCommRing Top).obj R)

namespace continuous_functions

/-- Pulling back functions into a topological ring along a continuous map is a ring homomorphism. -/
def pullback {X Y : Topᵒᵖ} (f : X ⟶ Y) (R : TopCommRing) :
  continuous_functions X R ⟶ continuous_functions Y R :=
{ to_fun := λ g, f.unop ≫ g,
  map_one' := rfl,
  map_zero' := rfl,
  map_add' := by tidy,
  map_mul' := by tidy }

/-- A homomorphism of topological rings can be postcomposed with functions from a source space `X`;
this is a ring homomorphism (with respect to the pointwise ring operations on functions). -/
def map (X : Top.{u}ᵒᵖ) {R S : TopCommRing.{u}} (φ : R ⟶ S) :
  continuous_functions X R ⟶ continuous_functions X S :=
{ to_fun := λ g, g ≫ ((forget₂ TopCommRing Top).map φ),
  map_one' := by ext; exact φ.1.map_one,
  map_zero' := by ext; exact φ.1.map_zero,
  map_add' := by intros; ext; apply φ.1.map_add,
  map_mul' := by intros; ext; apply φ.1.map_mul }
end continuous_functions

/-- An upgraded version of the Yoneda embedding, observing that the continuous maps
from `X : Top` to `R : TopCommRing` form a commutative ring, functorial in both `X` and `R`. -/
def CommRing_yoneda : TopCommRing.{u} ⥤ (Top.{u}ᵒᵖ ⥤ CommRing.{u}) :=
{ obj := λ R,
  { obj := λ X, continuous_functions X R,
    map := λ X Y f, continuous_functions.pullback f R,
    map_id' := λ X, by { ext, refl },
    map_comp' := λ X Y Z f g, rfl },
  map := λ R S φ,
  { app := λ X, continuous_functions.map X φ,
    naturality' := λ X Y f, rfl },
  map_id' := λ X, by { ext, refl },
  map_comp' := λ X Y Z f g, rfl }

/--
The presheaf (of commutative rings), consisting of functions on an open set `U ⊆ X` with
values in some topological commutative ring `T`.

For example, we could construct the presheaf of continuous complex valued functions of `X` as
```
presheaf_to_TopCommRing X (TopCommRing.of ℂ)
```
(this requires `import topology.instances.complex`).
-/
def presheaf_to_TopCommRing (T : TopCommRing.{v}) :
  X.presheaf CommRing.{v} :=
(opens.to_Top X).op ⋙ (CommRing_yoneda.obj T)

end Top


/-
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.translations
/-!
# Stabilisation of gcf Computations Under Termination

## Summary

We show that the continuants and convergents of a gcf stabilise once the gcf terminates.
-/

namespace generalized_continued_fraction
open stream.seq as seq

variables {K : Type*} {g : generalized_continued_fraction K} {n m : ℕ}

/-- If a gcf terminated at position `n`, it also terminated at `m ≥ n`.-/
lemma terminated_stable (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.terminated_at m :=
g.s.terminated_stable n_le_m terminated_at_n

variable [division_ring K]

lemma continuants_aux_stable_step_of_terminated (terminated_at_n : g.terminated_at n) :
  g.continuants_aux (n + 2) = g.continuants_aux (n + 1) :=
by { rw [terminated_at_iff_s_none] at terminated_at_n,
     simp only [terminated_at_n, continuants_aux] }

lemma continuants_aux_stable_of_terminated (n_lt_m : n < m)
  (terminated_at_n : g.terminated_at n) :
  g.continuants_aux m = g.continuants_aux (n + 1) :=
begin
  refine nat.le_induction rfl (λ k hnk hk, _) _ n_lt_m,
  rcases nat.exists_eq_add_of_lt hnk with ⟨k, rfl⟩,
  refine (continuants_aux_stable_step_of_terminated _).trans hk,
  exact terminated_stable (nat.le_add_right _ _) terminated_at_n
end

lemma convergents'_aux_stable_step_of_terminated {s : seq $ pair K}
  (terminated_at_n : s.terminated_at n) :
  convergents'_aux s (n + 1) = convergents'_aux s n :=
begin
  change s.nth n = none at terminated_at_n,
  induction n with n IH generalizing s,
  case nat.zero
  { simp only [convergents'_aux, terminated_at_n, seq.head] },
  case nat.succ
  { cases s_head_eq : s.head with gp_head,
    case option.none { simp only [convergents'_aux, s_head_eq] },
    case option.some
    { have : s.tail.terminated_at n, by simp only [seq.terminated_at, s.nth_tail, terminated_at_n],
      simp only [convergents'_aux, s_head_eq, (IH this)] } }
end

lemma convergents'_aux_stable_of_terminated
  {s : seq $ pair K} (n_le_m : n ≤ m)
  (terminated_at_n : s.terminated_at n) :
  convergents'_aux s m = convergents'_aux s n :=
begin
  induction n_le_m with m n_le_m IH,
  { refl },
  { refine (convergents'_aux_stable_step_of_terminated _).trans IH,
    exact s.terminated_stable n_le_m terminated_at_n }
end

lemma numerators_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.numerators m = g.numerators n :=
by simp only [num_eq_conts_a, (continuants_stable_of_terminated n_le_m terminated_at_n)]

lemma denominators_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.denominators m = g.denominators n :=
by simp only [denom_eq_conts_b, (continuants_stable_of_terminated n_le_m terminated_at_n)]

lemma convergents_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.convergents m = g.convergents n :=
by simp only [convergents, (denominators_stable_of_terminated n_le_m terminated_at_n),
  (numerators_stable_of_terminated n_le_m terminated_at_n)]

lemma convergents'_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) :
  g.convergents' m = g.convergents' n :=
by simp only [convergents', (convergents'_aux_stable_of_terminated n_le_m terminated_at_n)]

end generalized_continued_fraction