import data.pfun order.bounded_lattice algebra.ordered_group

open roption lattice

@[elab_as_eliminator] lemma roption.induction_on {α : Type*} {P : roption α → Prop} (a : roption α)
  (hnone : P none) (hsome : ∀ a : α, P (some a)) : P a :=
(classical.em a.dom).elim
  (λ h, roption.some_get h ▸ hsome _)
  (λ h, (eq_none_iff'.2 h).symm ▸ hnone)

def enat : Type := roption ℕ

namespace enat

instance : has_zero enat := ⟨some 0⟩
instance : has_one enat := ⟨some 1⟩
instance : has_add enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, get x h.1 + get y h.2⟩⟩
instance : has_coe ℕ enat := ⟨some⟩

lemma coe_inj {x y : ℕ} : (x : enat) = y ↔ x = y := roption.some_inj

instance : add_comm_monoid enat :=
{ add       := (+),
  zero      := (0),
  add_comm  := λ x y, roption.ext' and.comm (λ _ _, add_comm _ _),
  zero_add  := λ x, roption.ext' (true_and _) (λ _ _, zero_add _),
  add_zero  := λ x, roption.ext' (and_true _) (λ _ _, add_zero _),
  add_assoc := λ x y z, roption.ext' and.assoc (λ _ _, add_assoc _ _ _) }

instance : has_le enat := ⟨λ x y, ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy⟩
instance : has_top enat := ⟨none⟩
instance : has_bot enat := ⟨0⟩
instance : has_sup enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, x.get h.1 ⊔ y.get h.2⟩⟩
-- instance : has_inf enat := ⟨λ x y, ⟨x.dom ∨ y.dom, λ h, _⟩⟩

@[simp] lemma top_add (x : enat) : ⊤ + x = ⊤ :=
roption.ext' (false_and _) (λ h, h.left.elim)

@[simp] lemma add_top (x : enat) : x + ⊤ = ⊤ :=
by rw [add_comm, top_add]

@[simp] lemma coe_zero : ((0 : ℕ) : enat) = 0 := rfl

@[simp] lemma coe_one : ((1 : ℕ) : enat) = 1 := rfl

@[simp] lemma coe_add (x y : ℕ) : ((x + y : ℕ) : enat) = x + y :=
roption.ext' (and_true _).symm (λ _ _, rfl)

@[simp] lemma coe_add_get {x : ℕ} {y : enat} (h : ((x : enat) + y).dom) :
  get ((x : enat) + y) h = x + get y h.2 := rfl

@[simp] lemma add_coe_get {x : enat} {y : ℕ} (h : (x + y).dom) :
  get (x + y : enat) h = get x h.1 + y := rfl

instance : partial_order enat :=
{ le          := (≤),
  le_refl     := λ x, ⟨id, λ _, le_refl _⟩,
  le_trans    := λ x y z ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩,
    ⟨hxy₁ ∘ hyz₁, λ _, le_trans (hxy₂ _) (hyz₂ _)⟩,
  le_antisymm := λ x y ⟨hxy₁, hxy₂⟩ ⟨hyx₁, hyx₂⟩, roption.ext' ⟨hyx₁, hxy₁⟩
    (λ _ _, le_antisymm (hxy₂ _) (hyx₂ _)) }

@[simp] lemma coe_le_coe {x y : ℕ} : (x : enat) ≤ y ↔ x ≤ y :=
⟨λ ⟨_, h⟩, h trivial, λ h, ⟨λ _, trivial, λ _, h⟩⟩

@[simp] lemma coe_lt_coe {x y : ℕ} : (x : enat) < y ↔ x < y :=
by rw [lt_iff_le_not_le, lt_iff_le_not_le, coe_le_coe, coe_le_coe]

instance semilattice_sup_bot : semilattice_sup_bot enat :=
{ sup := (⊔),
  bot := (⊥),
  bot_le := λ _, ⟨λ _, trivial, λ _, nat.zero_le _⟩,
  le_sup_left := λ _ _, ⟨and.left, λ _, le_sup_left⟩,
  le_sup_right := λ _ _, ⟨and.right, λ _, le_sup_right⟩,
  sup_le := λ x y z ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩, ⟨λ hz, ⟨hx₁ hz, hy₁ hz⟩,
    λ _, sup_le (hx₂ _) (hy₂ _)⟩,
  ..enat.partial_order }

instance : order_top enat :=
{ top := (⊤),
  le_top := λ x, ⟨λ h, false.elim h, λ hy, false.elim hy⟩,
  ..enat.semilattice_sup_bot }

lemma coe_lt_top (x : ℕ) : (x : enat) < ⊤ :=
lt_of_le_of_ne le_top (λ h, absurd (congr_arg dom h) true_ne_false)

instance : linear_order enat :=
{ le_total := λ x y, roption.induction_on x
    (or.inr le_top) (roption.induction_on y (λ _, or.inl le_top)
      (λ x y, (le_total x y).elim (or.inr ∘ coe_le_coe.2)
        (or.inl ∘ coe_le_coe.2))),
  ..enat.partial_order }

instance : ordered_comm_monoid enat :=
{ add_le_add_left := λ a b ⟨h₁, h₂⟩ c,
    roption.induction_on c (show ⊤ + _ ≤ ⊤ + _, by simp)
      (λ c, ⟨λ h, and.intro trivial (h₁ h.2),
        λ _, add_le_add_left (h₂ _) c⟩),
  lt_of_add_lt_add_left := λ a b c, roption.induction_on a
    (λ h : ⊤ + _ < ⊤ + _, by simpa [lt_irrefl] using h)
    (λ a, roption.induction_on b
      (λ h : _ + ⊤ < _, absurd h (not_lt_of_ge (by rw add_top; exact le_top)))
      (λ b, roption.induction_on c
        (λ _, coe_lt_top _)
        (λ c (h : (a + b : enat) < a + c),
          coe_lt_coe.2 (by rw [← coe_add, ← coe_add, coe_lt_coe] at h;
            exact lt_of_add_lt_add_left h)))),
  ..enat.linear_order,
  ..enat.add_comm_monoid }

instance : canonically_ordered_monoid enat :=
{ le_iff_exists_add := λ a b, roption.induction_on b
    (iff_of_true le_top ⟨⊤, (add_top _).symm⟩)
    (λ b, roption.induction_on a
      (iff_of_false (not_le_of_gt (coe_lt_top _))
        (not_exists.2 (λ x, ne_of_lt (show _ < ⊤ + _, by rw [top_add]; exact coe_lt_top _))))
      (λ a, ⟨λ h, ⟨(b - a : ℕ), show (b : enat) = a + (b - a : ℕ),
          by rw [← coe_add, coe_inj, add_comm, nat.sub_add_cancel (coe_le_coe.1 h)]⟩,
        (λ ⟨c, hc⟩, roption.induction_on c
          (λ hc, hc.symm ▸ show (a : enat) ≤ a + ⊤, by rw [add_top]; exact le_top)
          (λ c (hc : (b : enat) = a + c),
            coe_le_coe.2 (by rw [← coe_add, coe_inj] at hc;
              rw hc; exact nat.le_add_right _ _)) hc)⟩))
  ..enat.ordered_comm_monoid }

end enat


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

! This file was ported from Lean 3 source module topology.algebra.module.linear_pmap
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.LinearPmap
import Mathbin.Topology.Algebra.Module.Basic

/-!
# Partially defined linear operators over topological vector spaces

We define basic notions of partially defined linear operators, which we call unbounded operators
for short.
In this file we prove all elementary properties of unbounded operators that do not assume that the
underlying spaces are normed.

## Main definitions

* `linear_pmap.is_closed`: An unbounded operator is closed iff its graph is closed.
* `linear_pmap.is_closable`: An unbounded operator is closable iff the closure of its graph is a
  graph.
* `linear_pmap.closure`: For a closable unbounded operator `f : linear_pmap R E F` the closure is
  the smallest closed extension of `f`. If `f` is not closable, then `f.closure` is defined as `f`.
* `linear_pmap.has_core`: a submodule contained in the domain is a core if restricting to the core
  does not lose information about the unbounded operator.

## Main statements

* `linear_pmap.closable_iff_exists_closed_extension`: an unbounded operator is closable iff it has a
  closed extension.
* `linear_pmap.closable.exists_unique`: there exists a unique closure
* `linear_pmap.closure_has_core`: the domain of `f` is a core of its closure

## References

* [J. Weidmann, *Linear Operators in Hilbert Spaces*][weidmann_linear]

## Tags

Unbounded operators, closed operators
-/

open Topology

variable {R E F : Type _}

variable [CommRing R] [AddCommGroup E] [AddCommGroup F]

variable [Module R E] [Module R F]

variable [TopologicalSpace E] [TopologicalSpace F]

namespace LinearPMap

/-! ### Closed and closable operators -/

/-- An unbounded operator is closed iff its graph is closed. -/
def IsClosed (f : E →ₗ.[R] F) : Prop :=
  IsClosed (f.graph : Set (E × F))
#align linear_pmap.is_closed LinearPMap.IsClosed

variable [ContinuousAdd E] [ContinuousAdd F]

variable [TopologicalSpace R] [ContinuousSMul R E] [ContinuousSMul R F]

/-- An unbounded operator is closable iff the closure of its graph is a graph. -/
def IsClosable (f : E →ₗ.[R] F) : Prop :=
  ∃ f' : LinearPMap R E F, f.graph.topologicalClosure = f'.graph
#align linear_pmap.is_closable LinearPMap.IsClosable

/-- A closed operator is trivially closable. -/
theorem IsClosed.isClosable {f : E →ₗ.[R] F} (hf : f.IsClosed) : f.IsClosable :=
  ⟨f, hf.submodule_topologicalClosure_eq⟩
#align linear_pmap.is_closed.is_closable LinearPMap.IsClosed.isClosable

/-- If `g` has a closable extension `f`, then `g` itself is closable. -/
theorem IsClosable.leIsClosable {f g : E →ₗ.[R] F} (hf : f.IsClosable) (hfg : g ≤ f) :
    g.IsClosable := by
  cases' hf with f' hf
  have : g.graph.topological_closure ≤ f'.graph :=
    by
    rw [← hf]
    exact Submodule.topologicalClosure_mono (le_graph_of_le hfg)
  refine' ⟨g.graph.topological_closure.to_linear_pmap _, _⟩
  · intro x hx hx'
    cases x
    exact f'.graph_fst_eq_zero_snd (this hx) hx'
  rw [Submodule.toLinearPMap_graph_eq]
#align linear_pmap.is_closable.le_is_closable LinearPMap.IsClosable.leIsClosable

/-- The closure is unique. -/
theorem IsClosable.existsUnique {f : E →ₗ.[R] F} (hf : f.IsClosable) :
    ∃! f' : E →ₗ.[R] F, f.graph.topologicalClosure = f'.graph :=
  by
  refine' existsUnique_of_exists_of_unique hf fun _ _ hy₁ hy₂ => eq_of_eq_graph _
  rw [← hy₁, ← hy₂]
#align linear_pmap.is_closable.exists_unique LinearPMap.IsClosable.existsUnique

open Classical

/-- If `f` is closable, then `f.closure` is the closure. Otherwise it is defined
as `f.closure = f`. -/
noncomputable def closure (f : E →ₗ.[R] F) : E →ₗ.[R] F :=
  if hf : f.IsClosable then hf.some else f
#align linear_pmap.closure LinearPMap.closure

theorem closure_def {f : E →ₗ.[R] F} (hf : f.IsClosable) : f.closure = hf.some := by
  simp [closure, hf]
#align linear_pmap.closure_def LinearPMap.closure_def

theorem closure_def' {f : E →ₗ.[R] F} (hf : ¬f.IsClosable) : f.closure = f := by simp [closure, hf]
#align linear_pmap.closure_def' LinearPMap.closure_def'

/-- The closure (as a submodule) of the graph is equal to the graph of the closure
  (as a `linear_pmap`). -/
theorem IsClosable.graph_closure_eq_closure_graph {f : E →ₗ.[R] F} (hf : f.IsClosable) :
    f.graph.topologicalClosure = f.closure.graph :=
  by
  rw [closure_def hf]
  exact hf.some_spec
#align linear_pmap.is_closable.graph_closure_eq_closure_graph LinearPMap.IsClosable.graph_closure_eq_closure_graph

/-- A `linear_pmap` is contained in its closure. -/
theorem le_closure (f : E →ₗ.[R] F) : f ≤ f.closure :=
  by
  by_cases hf : f.is_closable
  · refine' le_of_le_graph _
    rw [← hf.graph_closure_eq_closure_graph]
    exact (graph f).le_topologicalClosure
  rw [closure_def' hf]
#align linear_pmap.le_closure LinearPMap.le_closure

theorem IsClosable.closure_mono {f g : E →ₗ.[R] F} (hg : g.IsClosable) (h : f ≤ g) :
    f.closure ≤ g.closure := by
  refine' le_of_le_graph _
  rw [← (hg.le_is_closable h).graph_closure_eq_closure_graph]
  rw [← hg.graph_closure_eq_closure_graph]
  exact Submodule.topologicalClosure_mono (le_graph_of_le h)
#align linear_pmap.is_closable.closure_mono LinearPMap.IsClosable.closure_mono

/-- If `f` is closable, then the closure is closed. -/
theorem IsClosable.closure_isClosed {f : E →ₗ.[R] F} (hf : f.IsClosable) : f.closure.IsClosed :=
  by
  rw [IsClosed, ← hf.graph_closure_eq_closure_graph]
  exact f.graph.is_closed_topological_closure
#align linear_pmap.is_closable.closure_is_closed LinearPMap.IsClosable.closure_isClosed

/-- If `f` is closable, then the closure is closable. -/
theorem IsClosable.closureIsClosable {f : E →ₗ.[R] F} (hf : f.IsClosable) : f.closure.IsClosable :=
  hf.closure_isClosed.IsClosable
#align linear_pmap.is_closable.closure_is_closable LinearPMap.IsClosable.closureIsClosable

theorem isClosable_iff_exists_closed_extension {f : E →ₗ.[R] F} :
    f.IsClosable ↔ ∃ (g : E →ₗ.[R] F)(hg : g.IsClosed), f ≤ g :=
  ⟨fun h => ⟨f.closure, h.closure_isClosed, f.le_closure⟩, fun ⟨_, hg, h⟩ =>
    hg.IsClosable.leIsClosable h⟩
#align linear_pmap.is_closable_iff_exists_closed_extension LinearPMap.isClosable_iff_exists_closed_extension

/-! ### The core of a linear operator -/

/-- A submodule `S` is a core of `f` if the closure of the restriction of `f` to `S` is again `f`.-/
structure HasCore (f : E →ₗ.[R] F) (S : Submodule R E) : Prop where
  le_domain : S ≤ f.domain
  closure_eq : (f.domRestrict S).closure = f
#align linear_pmap.has_core LinearPMap.HasCore

theorem hasCore_def {f : E →ₗ.[R] F} {S : Submodule R E} (h : f.HasCore S) :
    (f.domRestrict S).closure = f :=
  h.2
#align linear_pmap.has_core_def LinearPMap.hasCore_def

/-- For every unbounded operator `f` the submodule `f.domain` is a core of its closure.

Note that we don't require that `f` is closable, due to the definition of the closure. -/
theorem closureHasCore (f : E →ₗ.[R] F) : f.closure.HasCore f.domain :=
  by
  refine' ⟨f.le_closure.1, _⟩
  congr
  ext
  · simp only [dom_restrict_domain, Submodule.mem_inf, and_iff_left_iff_imp]
    intro hx
    exact f.le_closure.1 hx
  intro x y hxy
  let z : f.closure.domain := ⟨y.1, f.le_closure.1 y.2⟩
  have hyz : (y : E) = z := by simp
  rw [f.le_closure.2 hyz]
  exact dom_restrict_apply (hxy.trans hyz)
#align linear_pmap.closure_has_core LinearPMap.closureHasCore

end LinearPMap


/-
Copyright (c) 2022. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Yuma Mizuno, Oleksandr Manzyuk

! This file was ported from Lean 3 source module category_theory.monoidal.coherence
! leanprover-community/mathlib commit 4d0b6301ef962e6bd74462998943ce38b7adb132
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Monoidal.Free.Coherence
import Mathbin.CategoryTheory.Bicategory.CoherenceTactic

/-!
# A `coherence` tactic for monoidal categories, and `⊗≫` (composition up to associators)

We provide a `coherence` tactic,
which proves equations where the two sides differ by replacing
strings of monoidal structural morphisms with other such strings.
(The replacements are always equalities by the monoidal coherence theorem.)

A simpler version of this tactic is `pure_coherence`,
which proves that any two morphisms (with the same source and target)
in a monoidal category which are built out of associators and unitors
are equal.

We also provide `f ⊗≫ g`, the `monoidal_comp` operation,
which automatically inserts associators and unitors as needed
to make the target of `f` match the source of `g`.
-/

noncomputable section

universe v u

open CategoryTheory

open CategoryTheory.FreeMonoidalCategory

variable {C : Type u} [Category.{v} C] [MonoidalCategory C]

namespace CategoryTheory.MonoidalCategory

/-- A typeclass carrying a choice of lift of an object from `C` to `free_monoidal_category C`. -/
class LiftObj (X : C) where
  lift : FreeMonoidalCategory C
#align category_theory.monoidal_category.lift_obj CategoryTheory.MonoidalCategory.LiftObj

instance liftObjUnit : LiftObj (𝟙_ C) where lift := Unit
#align category_theory.monoidal_category.lift_obj_unit CategoryTheory.MonoidalCategory.liftObjUnit

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
instance liftObjTensor (X Y : C) [LiftObj X] [LiftObj Y] : LiftObj (X ⊗ Y)
    where lift := LiftObj.lift X ⊗ LiftObj.lift Y
#align category_theory.monoidal_category.lift_obj_tensor CategoryTheory.MonoidalCategory.liftObjTensor

instance (priority := 100) liftObjOf (X : C) : LiftObj X where lift := of X
#align category_theory.monoidal_category.lift_obj_of CategoryTheory.MonoidalCategory.liftObjOf

/-- A typeclass carrying a choice of lift of a morphism from `C` to `free_monoidal_category C`. -/
class LiftHom {X Y : C} [LiftObj X] [LiftObj Y] (f : X ⟶ Y) where
  lift : LiftObj.lift X ⟶ LiftObj.lift Y
#align category_theory.monoidal_category.lift_hom CategoryTheory.MonoidalCategory.LiftHom

instance liftHomId (X : C) [LiftObj X] : LiftHom (𝟙 X) where lift := 𝟙 _
#align category_theory.monoidal_category.lift_hom_id CategoryTheory.MonoidalCategory.liftHomId

instance liftHomLeftUnitorHom (X : C) [LiftObj X] : LiftHom (λ_ X).Hom
    where lift := (λ_ (LiftObj.lift X)).Hom
#align category_theory.monoidal_category.lift_hom_left_unitor_hom CategoryTheory.MonoidalCategory.liftHomLeftUnitorHom

instance liftHomLeftUnitorInv (X : C) [LiftObj X] : LiftHom (λ_ X).inv
    where lift := (λ_ (LiftObj.lift X)).inv
#align category_theory.monoidal_category.lift_hom_left_unitor_inv CategoryTheory.MonoidalCategory.liftHomLeftUnitorInv

instance liftHomRightUnitorHom (X : C) [LiftObj X] : LiftHom (ρ_ X).Hom
    where lift := (ρ_ (LiftObj.lift X)).Hom
#align category_theory.monoidal_category.lift_hom_right_unitor_hom CategoryTheory.MonoidalCategory.liftHomRightUnitorHom

instance liftHomRightUnitorInv (X : C) [LiftObj X] : LiftHom (ρ_ X).inv
    where lift := (ρ_ (LiftObj.lift X)).inv
#align category_theory.monoidal_category.lift_hom_right_unitor_inv CategoryTheory.MonoidalCategory.liftHomRightUnitorInv

instance liftHomAssociatorHom (X Y Z : C) [LiftObj X] [LiftObj Y] [LiftObj Z] :
    LiftHom (α_ X Y Z).Hom where lift := (α_ (LiftObj.lift X) (LiftObj.lift Y) (LiftObj.lift Z)).Hom
#align category_theory.monoidal_category.lift_hom_associator_hom CategoryTheory.MonoidalCategory.liftHomAssociatorHom

instance liftHomAssociatorInv (X Y Z : C) [LiftObj X] [LiftObj Y] [LiftObj Z] :
    LiftHom (α_ X Y Z).inv where lift := (α_ (LiftObj.lift X) (LiftObj.lift Y) (LiftObj.lift Z)).inv
#align category_theory.monoidal_category.lift_hom_associator_inv CategoryTheory.MonoidalCategory.liftHomAssociatorInv

instance liftHomComp {X Y Z : C} [LiftObj X] [LiftObj Y] [LiftObj Z] (f : X ⟶ Y) (g : Y ⟶ Z)
    [LiftHom f] [LiftHom g] : LiftHom (f ≫ g) where lift := LiftHom.lift f ≫ LiftHom.lift g
#align category_theory.monoidal_category.lift_hom_comp CategoryTheory.MonoidalCategory.liftHomComp

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
instance liftHomTensor {W X Y Z : C} [LiftObj W] [LiftObj X] [LiftObj Y] [LiftObj Z] (f : W ⟶ X)
    (g : Y ⟶ Z) [LiftHom f] [LiftHom g] : LiftHom (f ⊗ g)
    where lift := LiftHom.lift f ⊗ LiftHom.lift g
#align category_theory.monoidal_category.lift_hom_tensor CategoryTheory.MonoidalCategory.liftHomTensor

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`Hom] [] -/
-- We could likely turn this into a `Prop` valued existential if that proves useful.
/-- A typeclass carrying a choice of monoidal structural isomorphism between two objects.
Used by the `⊗≫` monoidal composition operator, and the `coherence` tactic.
-/
class MonoidalCoherence (X Y : C) [LiftObj X] [LiftObj Y] where
  Hom : X ⟶ Y
  [IsIso : IsIso hom]
#align category_theory.monoidal_category.monoidal_coherence CategoryTheory.MonoidalCategory.MonoidalCoherence

attribute [instance] monoidal_coherence.is_iso

namespace MonoidalCoherence

@[simps]
instance refl (X : C) [LiftObj X] : MonoidalCoherence X X :=
  ⟨𝟙 _⟩
#align category_theory.monoidal_category.monoidal_coherence.refl CategoryTheory.MonoidalCategory.MonoidalCoherence.refl

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance tensor (X Y Z : C) [LiftObj X] [LiftObj Y] [LiftObj Z] [MonoidalCoherence Y Z] :
    MonoidalCoherence (X ⊗ Y) (X ⊗ Z) :=
  ⟨𝟙 X ⊗ MonoidalCoherence.hom Y Z⟩
#align category_theory.monoidal_category.monoidal_coherence.tensor CategoryTheory.MonoidalCategory.MonoidalCoherence.tensor

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance tensorRight (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence (𝟙_ C) Y] :
    MonoidalCoherence X (X ⊗ Y) :=
  ⟨(ρ_ X).inv ≫ (𝟙 X ⊗ MonoidalCoherence.hom (𝟙_ C) Y)⟩
#align category_theory.monoidal_category.monoidal_coherence.tensor_right CategoryTheory.MonoidalCategory.MonoidalCoherence.tensorRight

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance tensorRight' (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence Y (𝟙_ C)] :
    MonoidalCoherence (X ⊗ Y) X :=
  ⟨(𝟙 X ⊗ MonoidalCoherence.hom Y (𝟙_ C)) ≫ (ρ_ X).Hom⟩
#align category_theory.monoidal_category.monoidal_coherence.tensor_right' CategoryTheory.MonoidalCategory.MonoidalCoherence.tensorRight'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance left (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] :
    MonoidalCoherence (𝟙_ C ⊗ X) Y :=
  ⟨(λ_ X).Hom ≫ MonoidalCoherence.hom X Y⟩
#align category_theory.monoidal_category.monoidal_coherence.left CategoryTheory.MonoidalCategory.MonoidalCoherence.left

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance left' (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] :
    MonoidalCoherence X (𝟙_ C ⊗ Y) :=
  ⟨MonoidalCoherence.hom X Y ≫ (λ_ Y).inv⟩
#align category_theory.monoidal_category.monoidal_coherence.left' CategoryTheory.MonoidalCategory.MonoidalCoherence.left'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance right (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] :
    MonoidalCoherence (X ⊗ 𝟙_ C) Y :=
  ⟨(ρ_ X).Hom ≫ MonoidalCoherence.hom X Y⟩
#align category_theory.monoidal_category.monoidal_coherence.right CategoryTheory.MonoidalCategory.MonoidalCoherence.right

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance right' (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] :
    MonoidalCoherence X (Y ⊗ 𝟙_ C) :=
  ⟨MonoidalCoherence.hom X Y ≫ (ρ_ Y).inv⟩
#align category_theory.monoidal_category.monoidal_coherence.right' CategoryTheory.MonoidalCategory.MonoidalCoherence.right'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance assoc (X Y Z W : C) [LiftObj W] [LiftObj X] [LiftObj Y] [LiftObj Z]
    [MonoidalCoherence (X ⊗ Y ⊗ Z) W] : MonoidalCoherence ((X ⊗ Y) ⊗ Z) W :=
  ⟨(α_ X Y Z).Hom ≫ MonoidalCoherence.hom (X ⊗ Y ⊗ Z) W⟩
#align category_theory.monoidal_category.monoidal_coherence.assoc CategoryTheory.MonoidalCategory.MonoidalCoherence.assoc

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance assoc' (W X Y Z : C) [LiftObj W] [LiftObj X] [LiftObj Y] [LiftObj Z]
    [MonoidalCoherence W (X ⊗ Y ⊗ Z)] : MonoidalCoherence W ((X ⊗ Y) ⊗ Z) :=
  ⟨MonoidalCoherence.hom W (X ⊗ Y ⊗ Z) ≫ (α_ X Y Z).inv⟩
#align category_theory.monoidal_category.monoidal_coherence.assoc' CategoryTheory.MonoidalCategory.MonoidalCoherence.assoc'

end MonoidalCoherence

/-- Construct an isomorphism between two objects in a monoidal category
out of unitors and associators. -/
def monoidalIso (X Y : C) [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] : X ≅ Y :=
  asIso (MonoidalCoherence.hom X Y)
#align category_theory.monoidal_category.monoidal_iso CategoryTheory.MonoidalCategory.monoidalIso

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example (X : C) : X ≅ X ⊗ 𝟙_ C ⊗ 𝟙_ C :=
  monoidalIso _ _

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example (X1 X2 X3 X4 X5 X6 X7 X8 X9 : C) :
    𝟙_ C ⊗ (X1 ⊗ X2 ⊗ (X3 ⊗ X4) ⊗ X5) ⊗ X6 ⊗ X7 ⊗ X8 ⊗ X9 ≅
      X1 ⊗ (X2 ⊗ X3) ⊗ X4 ⊗ (X5 ⊗ (𝟙_ C ⊗ X6) ⊗ X7) ⊗ X8 ⊗ X9 :=
  monoidalIso _ _

/-- Compose two morphisms in a monoidal category,
inserting unitors and associators between as necessary. -/
def monoidalComp {W X Y Z : C} [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] (f : W ⟶ X)
    (g : Y ⟶ Z) : W ⟶ Z :=
  f ≫ MonoidalCoherence.hom X Y ≫ g
#align category_theory.monoidal_category.monoidal_comp CategoryTheory.MonoidalCategory.monoidalComp

-- mathport name: «expr ⊗≫ »
infixr:80 " ⊗≫ " => monoidalComp

-- type as \ot \gg
/-- Compose two isomorphisms in a monoidal category,
inserting unitors and associators between as necessary. -/
def monoidalIsoComp {W X Y Z : C} [LiftObj X] [LiftObj Y] [MonoidalCoherence X Y] (f : W ≅ X)
    (g : Y ≅ Z) : W ≅ Z :=
  f ≪≫ asIso (MonoidalCoherence.hom X Y) ≪≫ g
#align category_theory.monoidal_category.monoidal_iso_comp CategoryTheory.MonoidalCategory.monoidalIsoComp

-- mathport name: «expr ≪⊗≫ »
infixr:80 " ≪⊗≫ " => monoidalIsoComp

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
-- type as \ot \gg
example {U V W X Y : C} (f : U ⟶ V ⊗ W ⊗ X) (g : (V ⊗ W) ⊗ X ⟶ Y) : U ⟶ Y :=
  f ⊗≫ g

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
-- To automatically insert unitors/associators at the beginning or end,
-- you can use `f ⊗≫ 𝟙 _`
example {W X Y Z : C} (f : W ⟶ (X ⊗ Y) ⊗ Z) : W ⟶ X ⊗ Y ⊗ Z :=
  f ⊗≫ 𝟙 _

@[simp]
theorem monoidalComp_refl {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : f ⊗≫ g = f ≫ g :=
  by
  dsimp [monoidal_comp]
  simp
#align category_theory.monoidal_category.monoidal_comp_refl CategoryTheory.MonoidalCategory.monoidalComp_refl

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example {U V W X Y : C} (f : U ⟶ V ⊗ W ⊗ X) (g : (V ⊗ W) ⊗ X ⟶ Y) :
    f ⊗≫ g = f ≫ (α_ _ _ _).inv ≫ g := by simp [monoidal_comp]

end CategoryTheory.MonoidalCategory

open CategoryTheory.MonoidalCategory

namespace Tactic

open Tactic

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/-- Auxilliary definition of `monoidal_coherence`,
being careful with namespaces to avoid shadowing.
-/
unsafe def mk_project_map_expr (e : expr) : tactic expr :=
  to_expr
    ``(CategoryTheory.FreeMonoidalCategory.projectMap id _ _
        (CategoryTheory.MonoidalCategory.LiftHom.lift $(e)))
#align tactic.mk_project_map_expr tactic.mk_project_map_expr

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
-- failed to format: unknown constant 'term.pseudo.antiquot'
/-- Coherence tactic for monoidal categories. -/ unsafe
  def
    monoidal_coherence
    : tactic Unit
    :=
      do
        let o ← get_options
          set_options <| o `class.instance_max_depth 128
          try sorry
          let q( $ ( lhs ) = $ ( rhs ) ) ← target
          let project_map_lhs ← mk_project_map_expr lhs
          let project_map_rhs ← mk_project_map_expr rhs
          to_expr ` `( $ ( project_map_lhs ) = $ ( project_map_rhs ) ) >>= tactic.change
          congr
#align tactic.monoidal_coherence tactic.monoidal_coherence

/-- `pure_coherence` uses the coherence theorem for monoidal categories to prove the goal.
It can prove any equality made up only of associators, unitors, and identities.
```lean
example {C : Type} [category C] [monoidal_category C] :
  (λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom :=
by pure_coherence
```

Users will typicall just use the `coherence` tactic, which can also cope with identities of the form
`a ≫ f ≫ b ≫ g ≫ c = a' ≫ f ≫ b' ≫ g ≫ c'`
where `a = a'`, `b = b'`, and `c = c'` can be proved using `pure_coherence`
-/
unsafe def pure_coherence : tactic Unit :=
  monoidal_coherence <|> bicategorical_coherence
#align tactic.pure_coherence tactic.pure_coherence

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.pure_coherence -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example (X₁ X₂ : C) :
    ((λ_ (𝟙_ C)).inv ⊗ 𝟙 (X₁ ⊗ X₂)) ≫
        (α_ (𝟙_ C) (𝟙_ C) (X₁ ⊗ X₂)).Hom ≫ (𝟙 (𝟙_ C) ⊗ (α_ (𝟙_ C) X₁ X₂).inv) =
      𝟙 (𝟙_ C) ⊗ (λ_ X₁).inv ⊗ 𝟙 X₂ :=
  by
  run_tac
    pure_coherence

namespace Coherence

-- We have unused typeclass arguments here.
-- They are intentional, to ensure that `simp only [assoc_lift_hom]` only left associates
-- monoidal structural morphisms.
/-- Auxiliary simp lemma for the `coherence` tactic:
this moves brackets to the left in order to expose a maximal prefix
built out of unitors and associators.
-/
@[nolint unused_arguments]
theorem assoc_liftHom {W X Y Z : C} [LiftObj W] [LiftObj X] [LiftObj Y] (f : W ⟶ X) (g : X ⟶ Y)
    (h : Y ⟶ Z) [LiftHom f] [LiftHom g] : f ≫ g ≫ h = (f ≫ g) ≫ h :=
  (Category.assoc _ _ _).symm
#align tactic.coherence.assoc_lift_hom Tactic.Coherence.assoc_liftHom

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Internal tactic used in `coherence`.

Rewrites an equation `f = g` as `f₀ ≫ f₁ = g₀ ≫ g₁`,
where `f₀` and `g₀` are maximal prefixes of `f` and `g` (possibly after reassociating)
which are "liftable" (i.e. expressible as compositions of unitors and associators).
-/
unsafe def liftable_prefixes : tactic Unit := do
  let o ← get_options
  set_options <| o `class.instance_max_depth 128
  (try sorry >> sorry) >> try sorry
#align tactic.coherence.liftable_prefixes tactic.coherence.liftable_prefixes

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic tactic.coherence.liftable_prefixes -/
example {W X Y Z : C} (f : Y ⟶ Z) (g) (w : False) : (λ_ _).Hom ≫ f = g :=
  by
  run_tac
    liftable_prefixes
  guard_target =ₐ (𝟙 _ ≫ (λ_ _).Hom) ≫ f = 𝟙 _ ≫ g
  cases w

theorem insert_id_lhs {C : Type _} [Category C] {X Y : C} (f g : X ⟶ Y) (w : f ≫ 𝟙 _ = g) : f = g :=
  by simpa using w
#align tactic.coherence.insert_id_lhs Tactic.Coherence.insert_id_lhs

theorem insert_id_rhs {C : Type _} [Category C] {X Y : C} (f g : X ⟶ Y) (w : f = g ≫ 𝟙 _) : f = g :=
  by simpa using w
#align tactic.coherence.insert_id_rhs Tactic.Coherence.insert_id_rhs

end Coherence

open Coherence

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- The main part of `coherence` tactic. -/
unsafe def coherence_loop : tactic Unit := do
  -- To prove an equality `f = g` in a monoidal category,
      -- first try the `pure_coherence` tactic on the entire equation:
      pure_coherence <|>
      do
      -- Otherwise, rearrange so we have a maximal prefix of each side
          -- that is built out of unitors and associators:
          liftable_prefixes <|>
          fail
            ("Something went wrong in the `coherence` tactic: " ++
              "is the target an equation in a monoidal category?")
      -- The goal should now look like `f₀ ≫ f₁ = g₀ ≫ g₁`,
        tactic.congr_core'
      -- and now we have two goals `f₀ = g₀` and `f₁ = g₁`.
            -- Discharge the first using `coherence`,
            focus1
            pure_coherence <|>
          fail "`coherence` tactic failed, subgoal not true in the free monoidal_category"
      -- Then check that either `g₀` is identically `g₁`,
          reflexivity <|>
          do
          (-- or that both are compositions,
              do
                let q(_ ≫ _ = _) ← target
                skip) <|>
              sorry
          (do
                let q(_ = _ ≫ _) ← target
                skip) <|>
              sorry
          let q(_ ≫ _ = _ ≫ _) ← target |
            fail "`coherence` tactic failed, non-structural morphisms don't match"
          tactic.congr_core'
          -- with identical first terms,
              reflexivity <|>
              fail "`coherence` tactic failed, non-structural morphisms don't match"
          -- and whose second terms can be identified by recursively called `coherence`.
            coherence_loop
#align tactic.coherence_loop tactic.coherence_loop

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Use the coherence theorem for monoidal categories to solve equations in a monoidal equation,
where the two sides only differ by replacing strings of monoidal structural morphisms
(that is, associators, unitors, and identities)
with different strings of structural morphisms with the same source and target.

That is, `coherence` can handle goals of the form
`a ≫ f ≫ b ≫ g ≫ c = a' ≫ f ≫ b' ≫ g ≫ c'`
where `a = a'`, `b = b'`, and `c = c'` can be proved using `pure_coherence`.

(If you have very large equations on which `coherence` is unexpectedly failing,
you may need to increase the typeclass search depth,
using e.g. `set_option class.instance_max_depth 500`.)
-/
unsafe def coherence : tactic Unit := do
  try sorry
  try sorry
  -- TODO: put similar normalization simp lemmas for monoidal categories
      try
      bicategory.whisker_simps
  coherence_loop
#align tactic.coherence tactic.coherence

run_cmd
  add_interactive [`pure_coherence, `coherence]

add_tactic_doc
  { Name := "coherence"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.coherence]
    tags := ["category theory"] }

example (f) : (λ_ (𝟙_ C)).Hom ≫ f ≫ (λ_ (𝟙_ C)).Hom = (ρ_ (𝟙_ C)).Hom ≫ f ≫ (ρ_ (𝟙_ C)).Hom := by
  coherence

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example {U V W X Y : C} (f : U ⟶ V ⊗ W ⊗ X) (g : (V ⊗ W) ⊗ X ⟶ Y) :
    f ⊗≫ g = f ≫ (α_ _ _ _).inv ≫ g := by coherence

example {U : C} (f : U ⟶ 𝟙_ C) : f ≫ (ρ_ (𝟙_ C)).inv ≫ (λ_ (𝟙_ C)).Hom = f := by coherence

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
example (W X Y Z : C) (f) :
    ((α_ W X Y).Hom ⊗ 𝟙 Z) ≫
        (α_ W (X ⊗ Y) Z).Hom ≫
          (𝟙 W ⊗ (α_ X Y Z).Hom) ≫ f ≫ (α_ (W ⊗ X) Y Z).Hom ≫ (α_ W X (Y ⊗ Z)).Hom =
      (α_ (W ⊗ X) Y Z).Hom ≫
        (α_ W X (Y ⊗ Z)).Hom ≫
          f ≫ ((α_ W X Y).Hom ⊗ 𝟙 Z) ≫ (α_ W (X ⊗ Y) Z).Hom ≫ (𝟙 W ⊗ (α_ X Y Z).Hom) :=
  by coherence

end Tactic


import data.real.basic
import algebra.big_operators.basic
import topology.algebra.infinite_sum
import data.finset.basic
import logic.equiv.basic
import analysis.normed_space.basic
import analysis.specific_limits.normed

import Lbar.bounded
import pseudo_normed_group.basic

import for_mathlib.tsum

/-!

## $\overline{\mathcal{M}}_{r'}(S)$

This file contains a definition of `ℳ-bar_{r'}(S) as defined at the very beginning
of section 9 of `Analytic.pdf` (p57), and its action of `T⁻¹`.

## Implementation issues

We model Tℤ[[T]] as functions ℕ → ℤ which vanish at 0.

-/

universe u

noncomputable theory
open_locale big_operators nnreal

section defs

set_option old_structure_cmd true

/-- `Lbar r S` is the set of power series
`F_s = ∑ a_{s,n}T^n ∈ Tℤ[[T]]` such that `∑_{s,n} |a_{s,n}|r^n` converges
(or equivalently, because `S` is a finite type, such that for each `s : S`,
`∑_n |a_{s,n}|r^n` converges. ) -/
structure Lbar (r' : ℝ≥0) (S : Type u) [fintype S] :=
(to_fun      : S → ℕ → ℤ)
(coeff_zero' : ∀ s, to_fun s 0 = 0)
(summable'   : ∀ s, summable (λ n, (↑(to_fun s n).nat_abs * r' ^ n)))

end defs

variables {r' : ℝ≥0} {S : Type u} [fintype S]

namespace Lbar

instance has_coe_to_fun : has_coe_to_fun (Lbar r' S) (λ _, S → ℕ → ℤ) := ⟨Lbar.to_fun⟩

@[simp] lemma coe_mk (x h₁ h₂) : ((⟨x, h₁, h₂⟩ : Lbar r' S) : S → ℕ → ℤ) = x := rfl

@[simp] protected lemma coeff_zero (x : Lbar r' S) (s : S) : x s 0 = 0 := x.coeff_zero' s

protected lemma summable (x : Lbar r' S) (s : S) :
  summable (λ n, (↑(x s n).nat_abs * r' ^ n)) := x.summable' s

lemma summable_coe_real (x : Lbar r' S) (s : S) :
  summable (λ n, ∥x s n∥ * r' ^ n) :=
by simpa only [← nnreal.summable_coe, nnreal.coe_nat_cast, nnreal.coe_nat_abs,
  nnreal.coe_mul, nnreal.coe_pow] using x.summable s

@[ext] lemma ext (x y : Lbar r' S) (h : (⇑x : S → ℕ → ℤ) = y) : x = y :=
by { cases x, cases y, congr, exact h }

lemma ext_iff (x y : Lbar r' S) : x = y ↔ (x : S → ℕ → ℤ) = y :=
⟨congr_arg _, ext x y⟩

/-- The zero element of `Lbar r' S`, defined as the constant 0-function. -/
def zero : Lbar r' S :=
{ to_fun := 0,
  coeff_zero' := λ s, rfl,
  summable' := λ s, by simpa using summable_zero }

/-- Addition in `Lbar r' S`, defined as pointwise addition. -/
def add (F : Lbar r' S) (G : Lbar r' S) : Lbar r' S :=
{ to_fun := F + G,
  coeff_zero' := λ s, by simp [F.coeff_zero s, G.coeff_zero s],
  summable' :=
  begin
    intro s,
    apply nnreal.summable_of_le _ ((F.summable s).add (G.summable s)),
    intro n,
    rw [← add_mul, ← nat.cast_add],
    apply mul_le_mul_right',
    rw nat.cast_le,
    exact int.nat_abs_add_le _ _
  end }

/-- Subtraction in `Lbar r' S`, defined as pointwise subtraction. -/
def sub (F : Lbar r' S) (G : Lbar r' S) : Lbar r' S :=
{ to_fun := F - G,
  coeff_zero' := λ s, by simp [F.coeff_zero s, G.coeff_zero s],
  summable' :=
  begin
    intro s,
    apply nnreal.summable_of_le _ ((F.summable s).add (G.summable s)),
    intro n,
    rw [← add_mul, ← nat.cast_add],
    apply mul_le_mul_right',
    rw nat.cast_le,
    exact int.nat_abs_sub_le _ _
  end }

/-- Negation in `Lbar r' S`, defined as pointwise negation. -/
def neg (F : Lbar r' S) : Lbar r' S :=
{ to_fun := -F,
  coeff_zero' := λ s, by simp [F.coeff_zero s],
  summable' :=
  begin
    intro s,
    convert F.summable s using 1,
    ext n,
    simp only [pi.neg_apply, int.nat_abs_neg]
  end }

instance : has_zero (Lbar r' S) := ⟨zero⟩
instance : has_add (Lbar r' S) := ⟨add⟩
instance : has_sub (Lbar r' S) := ⟨sub⟩
instance : has_neg (Lbar r' S) := ⟨neg⟩

instance : inhabited (Lbar r' S) := ⟨0⟩

@[simp] lemma coe_zero : ⇑(0 : Lbar r' S) = 0 := rfl
@[simp] lemma coe_add (F G : Lbar r' S) : ⇑(F + G : Lbar r' S) = F + G := rfl
@[simp] lemma coe_sub (F G : Lbar r' S) : ⇑(F - G : Lbar r' S) = F - G := rfl
@[simp] lemma coe_neg (F : Lbar r' S) : ⇑(-F : Lbar r' S) = -F := rfl

--instance fff : topological_ring ℝ≥0 :=
--{ continuous_add := continuous_add,
--  continuous_mul := continuous_mul }

/-- Tailored scalar multiplication by natural numbers. -/
protected def nsmul (N : ℕ) (F : Lbar r' S) : Lbar r' S :=
{ to_fun := λ s n, N • F s n,
  coeff_zero' := λ s, by simp only [F.coeff_zero, smul_zero],
  summable' := λ s,
  begin
    convert summable.mul_left ↑N (F.summable' s),
    ext,
    simp only [←mul_assoc, nsmul_eq_mul, nonneg.coe_mul, int.nat_abs_mul],
    norm_cast
  end }

/-- Tailored scalar multiplication by integers. -/
protected def zsmul (N : ℤ) (F : Lbar r' S) : Lbar r' S :=
{ to_fun := λ s n, N • F s n,
  coeff_zero' := λ s, by simp only [F.coeff_zero, smul_zero],
  summable' := λ s,
  begin
    refine nnreal.summable_coe.mp _,
    convert summable.mul_left ↑N.nat_abs (nnreal.summable_coe.mpr (F.summable' s)),
    ext,
    simp only [←mul_assoc, int.nat_abs_mul, smul_eq_mul, nat.cast_mul, nonneg.coe_mul],
    norm_cast,
  end }

instance : add_comm_group (Lbar r' S) :=
{ zero := 0, add := (+), sub := has_sub.sub, neg := has_neg.neg,
  zero_add := by { intros, ext, simp only [coe_zero, zero_add, coe_add] },
  add_zero := by { intros, ext, simp only [coe_zero, add_zero, coe_add] },
  add_assoc := by { intros, ext, simp only [add_assoc, coe_add] },
  add_left_neg := by { intros, ext,
    simp only [coe_add, coe_neg, coe_zero, pi.add_apply, pi.zero_apply, pi.neg_apply, add_left_neg] },
  add_comm := by { intros, ext, simp only [coe_add, add_comm] },
  sub_eq_add_neg := by { intros, ext, simp only [coe_sub, coe_add, coe_neg, sub_eq_add_neg] },
  nsmul := λ n F, F.nsmul n,
  nsmul_zero' := λ F, by { ext, simp only [Lbar.nsmul, zero_smul], refl },
  nsmul_succ' := λ n F,
  begin
    ext,
    simp only [Lbar.nsmul, nat.succ_eq_add_one, add_smul, one_smul, add_comm, coe_mk, coe_add,
      pi.add_apply],
  end,
  zsmul := λ n F, F.zsmul n,
  zsmul_zero' := λ F, by { ext, simp only [Lbar.zsmul, zero_smul], refl },
  zsmul_succ' := λ n F,
  begin
    ext,
    simp only [Lbar.zsmul, nat.succ_eq_add_one, algebra.id.smul_eq_mul, coe_mk, pi.add_apply,
      int.coe_nat_succ, int.of_nat_eq_coe, coe_add, add_mul, one_mul, add_comm],
  end,
  zsmul_neg' := λ n F,
  begin
    ext,
    simp only [Lbar.zsmul, algebra.id.smul_eq_mul, coe_mk, pi.neg_apply, int.coe_nat_succ, coe_neg,
      add_mul, one_mul, neg_add_rev, int.neg_succ_of_nat_coe, neg_mul, one_mul],
  end }

lemma zero_apply (s : S) (n : ℕ) : (0 : Lbar r' S) s n = 0 := rfl

lemma zmul_apply (F : Lbar r' S) (c : ℤ) : (((c • F) : (Lbar r' S)) : S → ℕ → ℤ) = λ s n, c • (F s n) := rfl

lemma Fintype.Lbar_no_zero_smul_divisors (T : Fintype.{u}) (r') : no_zero_smul_divisors ℤ
  (Lbar r' T) :=
begin
  fconstructor,
  intros c F hF,
  by_cases hc : c = 0,
  { apply (or.intro_left), exact hc},
  { apply or.intro_right,
    ext s n,
    rw [ext_iff, zmul_apply, function.funext_iff] at hF,
    specialize hF s,
    rw function.funext_iff at hF,
    specialize hF n,
    simp only [smul_eq_zero, hc, false_or, zero_apply] at hF ⊢,
    exact hF },
end

/-- The `coeff s n` is the additive homomorphism that sends `x : Lbar r' S`
to the coefficient `x_{s,n}`. -/
@[simps]
def coeff (s : S) (n : ℕ) : Lbar r' S →+ ℤ :=
{ to_fun := λ x, x s n,
  map_zero' := rfl,
  map_add' := λ x y, rfl }

/-- The norm of `F : Lbar r' S` as nonnegative real number.
It is defined as `∑ s, ∑' n, (↑(F s n).nat_abs * r' ^ n)`. -/
protected def nnnorm (F : Lbar r' S) : ℝ≥0 := ∑ s, ∑' n, (↑(F s n).nat_abs * r' ^ n)

instance : has_nnnorm (Lbar r' S) := ⟨Lbar.nnnorm⟩

lemma nnnorm_def (F : Lbar r' S) : ∥F∥₊ = ∑ s, ∑' n, (↑(F s n).nat_abs * r' ^ n) := rfl

@[simp] lemma nnnorm_zero : ∥(0 : Lbar r' S)∥₊ = 0 :=
by simp only [nnnorm_def, Lbar.coe_zero, tsum_zero, nat.cast_zero, zero_mul, pi.zero_apply,
    zero_le', finset.sum_const_zero, int.nat_abs_zero]

@[simp] lemma nnnorm_neg (F : Lbar r' S) : ∥-F∥₊ = ∥F∥₊ :=
by simp only [nnnorm_def, Lbar.coe_neg, pi.neg_apply, int.nat_abs_neg, int.nat_abs,
  coe_neg, set.mem_set_of_eq]

lemma nnnorm_add_le (F₁ F₂ : Lbar r' S) : ∥F₁ + F₂∥₊ ≤ ∥F₁∥₊ + ∥F₂∥₊ :=
begin
  simp only [nnnorm_def, ← finset.sum_add_distrib],
  refine finset.sum_le_sum _,
  rintro s -,
  rw ← tsum_add (F₁.summable s) (F₂.summable s),
  refine tsum_le_tsum _ ((F₁ + F₂).summable _) ((F₁.summable s).add (F₂.summable s)),
  intro n,
  dsimp,
  rw [← add_mul, ← nat.cast_add],
  apply mul_le_mul_right',
  rw nat.cast_le,
  exact int.nat_abs_add_le _ _
end

lemma nnnorm_sum_le {ι : Type*} (s : finset ι) (F : ι → Lbar r' S) :
  ∥∑ i in s, F i∥₊ ≤ ∑ i in s, ∥F i∥₊ :=
begin
  classical,
  apply finset.induction_on s; clear s,
  { simp only [finset.sum_empty, nnnorm_zero] },
  intros i s his IH,
  simp only [finset.sum_insert his],
  exact (nnnorm_add_le _ _).trans (add_le_add le_rfl IH)
end

instance pseudo_normed_group : pseudo_normed_group (Lbar r' S) :=
{ filtration := λ c, {F | ∥F∥₊ ≤ c},
  filtration_mono := λ c₁ c₂ h F hF, le_trans hF h,
  zero_mem_filtration := λ c, by { dsimp, rw nnnorm_zero, apply zero_le' },
  neg_mem_filtration := λ c F hF, by { dsimp, rwa nnnorm_neg },
  add_mem_filtration := λ c₁ c₂ F₁ F₂ hF₁ hF₂,
  by exact le_trans (nnnorm_add_le _ _) (add_le_add hF₁ hF₂) }

lemma mem_filtration_iff (x : Lbar r' S) (c : ℝ≥0) :
  x ∈ pseudo_normed_group.filtration (Lbar r' S) c ↔ ∥x∥₊ ≤ c :=
iff.rfl

/--
The coercion from `Lbar r' S` to functions `S → ℕ → ℤ`.
This is an additive group homomorphism.
-/
def coe_hom : Lbar r' S →+ (S → ℕ → ℤ) :=
add_monoid_hom.mk' coe_fn $ coe_add

@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (F : ι → Lbar r' S) :
  ⇑(∑ i in s, F i) = ∑ i in s, (F i) :=
show coe_hom (∑ i in s, F i) = ∑ i in s, coe_hom (F i), from add_monoid_hom.map_sum _ _ _

@[simp] lemma coe_zsmul (n : ℤ) (F : Lbar r' S) : ⇑(n • F) = n • F := rfl

@[simp] lemma coe_nsmul (n : ℕ) (F : Lbar r' S) : ⇑(n • F) = n • F := rfl

@[simp] lemma nnnorm_zsmul (N : ℤ) (F : Lbar r' S) : ∥N • F∥₊ = ∥N∥₊ * ∥F∥₊ :=
begin
  simp only [nnnorm_def, finset.mul_sum],
  apply fintype.sum_congr,
  intro s,
  apply nnreal.eq,
  simp only [nnreal.coe_mul, nnreal.coe_tsum, ← tsum_mul_left, ← mul_assoc,
    nnreal.coe_nat_abs, coe_nnnorm, coe_zsmul, pi.smul_apply, int.norm_eq_abs,
    ← abs_mul, ← int.cast_mul, smul_eq_mul],
end

lemma nnnorm_nsmul (x : Lbar r' S) (N : ℕ) : ∥N • x∥₊ = N • ∥x∥₊ :=
by { rw [← coe_nat_zsmul, nnnorm_zsmul, nsmul_eq_mul, ← nnreal.coe_nat_abs], refl, }

section Tinv

/--
The action of T⁻¹.
-/
def Tinv_aux {R : Type*} [has_zero R] : (ℕ → R) → ℕ → R := λ F n, if n = 0 then 0 else F (n + 1)

@[simp] lemma Tinv_aux_zero {R : Type*} [has_zero R] (f : ℕ → R) : Tinv_aux f 0 = 0 := rfl

@[simp] lemma Tinv_aux_ne_zero {R : Type*} [has_zero R] (f : ℕ → R) (i : ℕ) (hi : i ≠ 0) :
  Tinv_aux f i = f (i + 1) :=
if_neg hi

@[simp] lemma Tinv_aux_succ {R : Type*} [has_zero R] (f : ℕ → R) (i : ℕ) :
  Tinv_aux f (i + 1) = f (i + 2) :=
if_neg (nat.succ_ne_zero i)

lemma Tinv_aux_summable [h0r : fact (0 < r')] (F : Lbar r' S) (s : S) :
  summable (λ n, (↑(Tinv_aux (F s) n).nat_abs * r' ^ n)) :=
begin
  have : ∀ n : ℕ, r' ^ n = r' ^ n * r' * r'⁻¹,
  { intro, rw [mul_inv_cancel_right₀ h0r.out.ne'] },
  conv { congr, funext, rw [this, ← mul_assoc] },
  apply summable.mul_right,
  refine nnreal.summable_of_le _ (nnreal.summable_nat_add _ (F.summable s) 1),
  rintro ⟨i⟩,
  { simp only [nat.cast_zero, zero_mul, Tinv_aux_zero, zero_le', int.nat_abs_zero] },
  { simp only [Tinv_aux_succ, pow_add, mul_assoc, pow_one] }
end

/--
The `T⁻¹` action on `Lbar r' S`.
This is defined, essentially, as a shift in `ℕ` (accounting for the restriction at 0).
This is an additive group homomorphism.
-/
def Tinv {r : ℝ≥0} {S : Type u} [fintype S] [h0r : fact (0 < r)] :
  Lbar r S →+ Lbar r S :=
add_monoid_hom.mk' (λ F,
  { to_fun := λ s, Tinv_aux (F s),
    coeff_zero' := λ s, rfl,
    summable' := Tinv_aux_summable F })
  begin
    intros F G,
    ext s (_|n),
    { simp only [add_zero, pi.add_apply, Lbar.coeff_zero] },
    { simp only [coe_mk, pi.add_apply, Tinv_aux_succ, coe_add] }
  end

@[simp] lemma Tinv_zero [fact (0 < r')] (F : Lbar r' S) (s : S) : Tinv F s 0 = 0 := rfl

@[simp] lemma Tinv_ne_zero [fact (0 < r')] (F : Lbar r' S) (s : S) (i : ℕ) (hi : i ≠ 0) :
  Tinv F s i = F s (i + 1) :=
if_neg hi

@[simp] lemma Tinv_succ [fact (0 < r')] (F : Lbar r' S) (s : S) (i : ℕ) :
  Tinv F s (i + 1) = F s (i + 2) :=
Tinv_aux_succ (F s) i

open pseudo_normed_group

lemma Tinv_mem_filtration [h0r : fact (0 < r')] :
  Tinv ∈ filtration (Lbar r' S →+ Lbar r' S) (r'⁻¹) :=
begin
  intros c F hF,
  simp only [Tinv, add_monoid_hom.mk'_apply],
  change _ ≤ _ at hF,
  rw mul_comm,
  apply le_mul_inv_of_mul_le h0r.out.ne',
  rw [nnnorm_def, finset.sum_mul],
  apply le_trans _ hF,
  apply finset.sum_le_sum,
  rintro s -,
  rw ← nnreal.tsum_mul_right,
  conv_rhs { rw [← sum_add_tsum_nat_add' 1 (F.summable s)] },
  refine le_add_of_nonneg_of_le zero_le' _,
  apply tsum_le_tsum,
  { rintro (_|i),
    { simp only [nat.cast_zero, zero_mul, Lbar.coeff_zero, int.nat_abs_zero], exact zero_le' },
    { simp only [Tinv_aux_succ, mul_assoc, coe_mk, pow_succ'] } },
  { exact (Tinv_aux_summable F s).mul_right _ },
  { exact (nnreal.summable_nat_add_iff 1).mpr (F.summable s) }
end

end Tinv

/-- `of_mask x mask : Lbar r' S` is `∑ a_{s,n}T^n ∈ Tℤ[[T]]`,
where `a_{s,n}` is `x_{s,n}` if `mask n s` is true and `0` otherwise. -/
@[simps]
def of_mask (x : Lbar r' S) (mask : S → ℕ → Prop) [∀ s n, decidable (mask s n)] :
  Lbar r' S :=
{ to_fun := λ s n, if mask s n then x s n else 0,
  coeff_zero' := λ s, by { split_ifs, { exact x.coeff_zero s }, { refl } },
  summable' := λ s,
  begin
    apply nnreal.summable_of_le _ (x.summable s),
    intro n,
    refine mul_le_mul' _ le_rfl,
    norm_cast,
    split_ifs,
    { refl },
    { rw int.nat_abs_zero, exact zero_le' }
  end }

variables (r' S)

/-- `geom r' S` is `∑ T^n ∈ Tℤ[[T]]`.
In other words, all non-constant coefficients are `1`. -/
@[simps]
def geom [hr' : fact (r' < 1)] : Lbar r' S :=
{ to_fun := λ s n, if n = 0 then 0 else 1,
  coeff_zero' := λ s, if_pos rfl,
  summable' := λ s,
  begin
    have := (@summable_geometric_of_norm_lt_1 _ _ (r' : ℝ) _), swap,
    { rw nnreal.norm_eq, exact hr'.out },
    simp only [← nnreal.coe_pow, nnreal.summable_coe] at this,
    apply nnreal.summable_of_le _ this,
    intro n,
    refine (mul_le_mul' _ le_rfl).trans (one_mul _).le,
    split_ifs; simp
  end }

section map

variables {r' S} {T : Type*} [fintype T] (f : S → T)

open_locale classical

lemma has_sum_aux (F : Lbar r' S) :
  has_sum (λ n : ℕ, (∑ s, ↑(F s n).nat_abs) * r' ^ n) (∑ s, ∑' n, (F s n).nat_abs * r' ^ n) :=
begin
  have : (λ (n : ℕ), (∑ (s : S), ↑(F s n).nat_abs) * r' ^ n) =
    (λ (n : ℕ), ∑ (s : S), (↑(F s n).nat_abs) * r' ^ n),
  { funext n,
    rw finset.sum_mul },
  rw this, clear this,
  exact has_sum_sum (λ s _, (F.summable s).has_sum)
end

/-- Given an element of `Lbar r' S` and a function `f : S → T`, this
  constructs an associated element of `Lbar r' T`. -/
@[simps]
def map : Lbar r' S → Lbar r' T := λ F,
{ to_fun := λ t n, ∑ s in finset.univ.filter (λ s', f s' = t), F s n,
  coeff_zero' := λ s, by simp,
  summable' := λ t, begin
    have : ∀ (n : ℕ),
      ↑((∑ (s : S) in finset.univ.filter (λ (s' : S), f s' = t), F s n).nat_abs) * r' ^ n ≤
      (∑ s : S, (F s n).nat_abs) * r' ^ n,
    { intro n,
      refine mul_le_mul _ (le_refl _) zero_le' zero_le',
      simp_rw ← nat.cast_sum,
      apply nat.cast_le.mpr,
      have : (∑ (s : S) in finset.univ.filter (λ (s' : S), f s' = t), F s n).nat_abs ≤
        ∑ (s : S) in finset.univ.filter (λ s', f s' = t), (F s n).nat_abs,
      { apply nat_abs_sum_le },
      refine le_trans this _,
      apply finset.sum_le_sum_of_subset,
      { intros t ht, simp },
      { apply_instance } },
    exact nnreal.summable_of_le this (has_sum.summable (has_sum_aux _)),
  end }

lemma map_id (F : Lbar r' S) : F.map id = F :=
begin
  ext s n,
  simp [finset.sum_filter],
end

lemma map_comp (F : Lbar r' S) {U : Type*} [fintype U] (g : T → U) :
  F.map (g ∘ f) = (F.map f).map g :=
begin
  ext u n,
  dsimp,
  rw ← finset.sum_bUnion,
  { apply finset.sum_congr,
    ext s,
    split,
    { intro hs,
      simpa using hs },
    { intro hs,
      simpa using hs },
    { tauto } },
  { rintros t1 ht1 t2 ht2 h s hs,
    simp at ht1 ht2 hs ⊢,
    refine h _,
    rw [← hs.1, ← hs.2] }
end

lemma nnnorm_map_le_of_nnnorm_le {c : ℝ≥0} (F : Lbar r' S) (hF : ∥ F ∥₊ ≤ c) :
  ∥ F.map f ∥₊ ≤ c :=
begin
  simp [ Lbar.nnnorm_def ] at *,
  rw ← tsum_sum at hF ⊢,
  { refine le_trans (tsum_le_tsum _ _ _) hF,
    { intros n,
      simp_rw ← finset.sum_mul,
      refine mul_le_mul _ (le_refl _) zero_le' zero_le',
      simp_rw ← nat.cast_sum,
      rw nat.cast_le,
      have : ∑ (x : T), (∑ (s : S) in finset.univ.filter (λ (s' : S), f s' = x), F s n).nat_abs ≤
        ∑ (x : T), (∑ (s : S) in finset.univ.filter (λ s', f s' = x), (F s n).nat_abs),
      { apply finset.sum_le_sum,
        intros t ht,
        apply nat_abs_sum_le },
      refine le_trans this _,
      rw ← finset.sum_bUnion,
      apply finset.sum_le_sum_of_subset,
      { intros t ht, simp },
      { intros t1 ht1 t2 ht2 h s hs,
        simp at ht1 ht2 hs ⊢,
        apply h,
        rw [← hs.1, ← hs.2] } },
    { apply summable_sum,
      intros t ht,
      apply (F.map f).summable },
    { apply summable_sum,
      intros s hs,
      apply F.summable } },
  { intros t ht,
    apply (F.map f).summable },
  { intros s hs,
    apply F.summable }
end

end map

end Lbar

#lint-


/-
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

! This file was ported from Lean 3 source module algebraic_topology.dold_kan.p_infty
! leanprover-community/mathlib commit 31019c2504b17f85af7e0577585fad996935a317
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.DoldKan.Projections
import Mathbin.CategoryTheory.Idempotents.FunctorCategories
import Mathbin.CategoryTheory.Idempotents.FunctorExtension

/-!

# Construction of the projection `P_infty` for the Dold-Kan correspondence

TODO (@joelriou) continue adding the various files referenced below

In this file, we construct the projection `P_infty : K[X] ⟶ K[X]` by passing
to the limit the projections `P q` defined in `projections.lean`. This
projection is a critical tool in this formalisation of the Dold-Kan correspondence,
because in the case of abelian categories, `P_infty` corresponds to the
projection on the normalized Moore subcomplex, with kernel the degenerate subcomplex.
(See `equivalence.lean` for the general strategy of proof.)

-/

open CategoryTheory

open CategoryTheory.Category

open CategoryTheory.Preadditive

open CategoryTheory.SimplicialObject

open CategoryTheory.Idempotents

open Opposite

open Simplicial DoldKan

noncomputable section

namespace AlgebraicTopology

namespace DoldKan

variable {C : Type _} [Category C] [Preadditive C] {X : SimplicialObject C}

theorem p_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) :
    ((p (q + 1)).f n : X _[n] ⟶ _) = (p q).f n :=
  by
  cases n
  · simp only [P_f_0_eq]
  · unfold P
    simp only [add_right_eq_self, comp_add, HomologicalComplex.comp_f,
      HomologicalComplex.add_f_apply, comp_id]
    exact (higher_faces_vanish.of_P q n).comp_hσ_eq_zero (nat.succ_le_iff.mp hqn)
#align algebraic_topology.dold_kan.P_is_eventually_constant AlgebraicTopology.DoldKan.p_is_eventually_constant

theorem q_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) :
    ((q (q + 1)).f n : X _[n] ⟶ _) = (q q).f n := by
  simp only [Q, HomologicalComplex.sub_f_apply, P_is_eventually_constant hqn]
#align algebraic_topology.dold_kan.Q_is_eventually_constant AlgebraicTopology.DoldKan.q_is_eventually_constant

/-- The endomorphism `P_infty : K[X] ⟶ K[X]` obtained from the `P q` by passing to the limit. -/
def pInfty : K[X] ⟶ K[X] :=
  ChainComplex.ofHom _ _ _ _ _ _ (fun n => ((p n).f n : X _[n] ⟶ _)) fun n => by
    simpa only [← P_is_eventually_constant (show n ≤ n by rfl),
      alternating_face_map_complex.obj_d_eq] using (P (n + 1)).comm (n + 1) n
#align algebraic_topology.dold_kan.P_infty AlgebraicTopology.DoldKan.pInfty

/-- The endomorphism `Q_infty : K[X] ⟶ K[X]` obtained from the `Q q` by passing to the limit. -/
def qInfty : K[X] ⟶ K[X] :=
  𝟙 _ - pInfty
#align algebraic_topology.dold_kan.Q_infty AlgebraicTopology.DoldKan.qInfty

@[simp]
theorem pInfty_f_0 : (pInfty.f 0 : X _[0] ⟶ X _[0]) = 𝟙 _ :=
  rfl
#align algebraic_topology.dold_kan.P_infty_f_0 AlgebraicTopology.DoldKan.pInfty_f_0

theorem pInfty_f (n : ℕ) : (pInfty.f n : X _[n] ⟶ X _[n]) = (p n).f n :=
  rfl
#align algebraic_topology.dold_kan.P_infty_f AlgebraicTopology.DoldKan.pInfty_f

@[simp]
theorem qInfty_f_0 : (qInfty.f 0 : X _[0] ⟶ X _[0]) = 0 :=
  by
  dsimp [Q_infty]
  simp only [sub_self]
#align algebraic_topology.dold_kan.Q_infty_f_0 AlgebraicTopology.DoldKan.qInfty_f_0

theorem qInfty_f (n : ℕ) : (qInfty.f n : X _[n] ⟶ X _[n]) = (q n).f n :=
  rfl
#align algebraic_topology.dold_kan.Q_infty_f AlgebraicTopology.DoldKan.qInfty_f

@[simp, reassoc.1]
theorem pInfty_f_naturality (n : ℕ) {X Y : SimplicialObject C} (f : X ⟶ Y) :
    f.app (op [n]) ≫ pInfty.f n = pInfty.f n ≫ f.app (op [n]) :=
  p_f_naturality n n f
#align algebraic_topology.dold_kan.P_infty_f_naturality AlgebraicTopology.DoldKan.pInfty_f_naturality

@[simp, reassoc.1]
theorem qInfty_f_naturality (n : ℕ) {X Y : SimplicialObject C} (f : X ⟶ Y) :
    f.app (op [n]) ≫ qInfty.f n = qInfty.f n ≫ f.app (op [n]) :=
  q_f_naturality n n f
#align algebraic_topology.dold_kan.Q_infty_f_naturality AlgebraicTopology.DoldKan.qInfty_f_naturality

@[simp, reassoc.1]
theorem pInfty_f_idem (n : ℕ) : (pInfty.f n : X _[n] ⟶ _) ≫ pInfty.f n = pInfty.f n := by
  simp only [P_infty_f, P_f_idem]
#align algebraic_topology.dold_kan.P_infty_f_idem AlgebraicTopology.DoldKan.pInfty_f_idem

@[simp, reassoc.1]
theorem pInfty_idem : (pInfty : K[X] ⟶ _) ≫ pInfty = pInfty :=
  by
  ext n
  exact P_infty_f_idem n
#align algebraic_topology.dold_kan.P_infty_idem AlgebraicTopology.DoldKan.pInfty_idem

@[simp, reassoc.1]
theorem qInfty_f_idem (n : ℕ) : (qInfty.f n : X _[n] ⟶ _) ≫ qInfty.f n = qInfty.f n :=
  q_f_idem _ _
#align algebraic_topology.dold_kan.Q_infty_f_idem AlgebraicTopology.DoldKan.qInfty_f_idem

@[simp, reassoc.1]
theorem qInfty_idem : (qInfty : K[X] ⟶ _) ≫ qInfty = qInfty :=
  by
  ext n
  exact Q_infty_f_idem n
#align algebraic_topology.dold_kan.Q_infty_idem AlgebraicTopology.DoldKan.qInfty_idem

@[simp, reassoc.1]
theorem pInfty_f_comp_qInfty_f (n : ℕ) : (pInfty.f n : X _[n] ⟶ _) ≫ qInfty.f n = 0 :=
  by
  dsimp only [Q_infty]
  simp only [HomologicalComplex.sub_f_apply, HomologicalComplex.id_f, comp_sub, comp_id,
    P_infty_f_idem, sub_self]
#align algebraic_topology.dold_kan.P_infty_f_comp_Q_infty_f AlgebraicTopology.DoldKan.pInfty_f_comp_qInfty_f

@[simp, reassoc.1]
theorem pInfty_comp_qInfty : (pInfty : K[X] ⟶ _) ≫ qInfty = 0 :=
  by
  ext n
  apply P_infty_f_comp_Q_infty_f
#align algebraic_topology.dold_kan.P_infty_comp_Q_infty AlgebraicTopology.DoldKan.pInfty_comp_qInfty

@[simp, reassoc.1]
theorem qInfty_f_comp_pInfty_f (n : ℕ) : (qInfty.f n : X _[n] ⟶ _) ≫ pInfty.f n = 0 :=
  by
  dsimp only [Q_infty]
  simp only [HomologicalComplex.sub_f_apply, HomologicalComplex.id_f, sub_comp, id_comp,
    P_infty_f_idem, sub_self]
#align algebraic_topology.dold_kan.Q_infty_f_comp_P_infty_f AlgebraicTopology.DoldKan.qInfty_f_comp_pInfty_f

@[simp, reassoc.1]
theorem qInfty_comp_pInfty : (qInfty : K[X] ⟶ _) ≫ pInfty = 0 :=
  by
  ext n
  apply Q_infty_f_comp_P_infty_f
#align algebraic_topology.dold_kan.Q_infty_comp_P_infty AlgebraicTopology.DoldKan.qInfty_comp_pInfty

@[simp]
theorem pInfty_add_qInfty : (pInfty : K[X] ⟶ _) + qInfty = 𝟙 _ :=
  by
  dsimp only [Q_infty]
  simp only [add_sub_cancel'_right]
#align algebraic_topology.dold_kan.P_infty_add_Q_infty AlgebraicTopology.DoldKan.pInfty_add_qInfty

theorem pInfty_f_add_qInfty_f (n : ℕ) : (pInfty.f n : X _[n] ⟶ _) + qInfty.f n = 𝟙 _ :=
  HomologicalComplex.congr_hom pInfty_add_qInfty n
#align algebraic_topology.dold_kan.P_infty_f_add_Q_infty_f AlgebraicTopology.DoldKan.pInfty_f_add_qInfty_f

variable (C)

/-- `P_infty` induces a natural transformation, i.e. an endomorphism of
the functor `alternating_face_map_complex C`. -/
@[simps]
def natTransPInfty : alternatingFaceMapComplex C ⟶ alternatingFaceMapComplex C
    where
  app _ := pInfty
  naturality' X Y f := by
    ext n
    exact P_infty_f_naturality n f
#align algebraic_topology.dold_kan.nat_trans_P_infty AlgebraicTopology.DoldKan.natTransPInfty

/-- The natural transformation in each degree that is induced by `nat_trans_P_infty`. -/
@[simps]
def natTransPInftyF (n : ℕ) :=
  natTransPInfty C ◫ 𝟙 (HomologicalComplex.eval _ _ n)
#align algebraic_topology.dold_kan.nat_trans_P_infty_f AlgebraicTopology.DoldKan.natTransPInftyF

variable {C}

@[simp]
theorem map_pInfty_f {D : Type _} [Category D] [Preadditive D] (G : C ⥤ D) [G.Additive]
    (X : SimplicialObject C) (n : ℕ) :
    (pInfty : K[((whiskering C D).obj G).obj X] ⟶ _).f n =
      G.map ((pInfty : AlternatingFaceMapComplex.obj X ⟶ _).f n) :=
  by simp only [P_infty_f, map_P]
#align algebraic_topology.dold_kan.map_P_infty_f AlgebraicTopology.DoldKan.map_pInfty_f

/-- Given an object `Y : karoubi (simplicial_object C)`, this lemma
computes `P_infty` for the associated object in `simplicial_object (karoubi C)`
in terms of `P_infty` for `Y.X : simplicial_object C` and `Y.p`. -/
theorem karoubi_pInfty_f {Y : Karoubi (SimplicialObject C)} (n : ℕ) :
    ((pInfty : K[(karoubiFunctorCategoryEmbedding _ _).obj Y] ⟶ _).f n).f =
      Y.p.app (op [n]) ≫ (pInfty : K[Y.pt] ⟶ _).f n :=
  by
  -- We introduce P_infty endomorphisms P₁, P₂, P₃, P₄ on various objects Y₁, Y₂, Y₃, Y₄.
  let Y₁ := (karoubi_functor_category_embedding _ _).obj Y
  let Y₂ := Y.X
  let Y₃ := ((whiskering _ _).obj (to_karoubi C)).obj Y.X
  let Y₄ := (karoubi_functor_category_embedding _ _).obj ((to_karoubi _).obj Y.X)
  let P₁ : K[Y₁] ⟶ _ := P_infty
  let P₂ : K[Y₂] ⟶ _ := P_infty
  let P₃ : K[Y₃] ⟶ _ := P_infty
  let P₄ : K[Y₄] ⟶ _ := P_infty
  -- The statement of lemma relates P₁ and P₂.
  change (P₁.f n).f = Y.p.app (op [n]) ≫ P₂.f n
  -- The proof proceeds by obtaining relations h₃₂, h₄₃, h₁₄.
  have h₃₂ : (P₃.f n).f = P₂.f n := karoubi.hom_ext.mp (map_P_infty_f (to_karoubi C) Y₂ n)
  have h₄₃ : P₄.f n = P₃.f n :=
    by
    have h := functor.congr_obj (to_karoubi_comp_karoubi_functor_category_embedding _ _) Y₂
    simp only [← nat_trans_P_infty_f_app]
    congr
  let τ₁ := 𝟙 (karoubi_functor_category_embedding SimplexCategoryᵒᵖ C)
  let τ₂ := nat_trans_P_infty_f (karoubi C) n
  let τ := τ₁ ◫ τ₂
  have h₁₄ := idempotents.nat_trans_eq τ Y
  dsimp [τ, τ₁, τ₂, nat_trans_P_infty_f] at h₁₄
  rw [id_comp, id_comp, comp_id, comp_id] at h₁₄
  -- We use the three equalities h₃₂, h₄₃, h₁₄.
  rw [← h₃₂, ← h₄₃, h₁₄]
  simp only [karoubi_functor_category_embedding.map_app_f, karoubi.decomp_id_p_f,
    karoubi.decomp_id_i_f, karoubi.comp_f]
  let π : Y₄ ⟶ Y₄ := (to_karoubi _ ⋙ karoubi_functor_category_embedding _ _).map Y.p
  have eq := karoubi.hom_ext.mp (P_infty_f_naturality n π)
  simp only [karoubi.comp_f] at eq
  dsimp [π] at eq
  rw [← Eq, reassoc_of (app_idem Y (op [n]))]
#align algebraic_topology.dold_kan.karoubi_P_infty_f AlgebraicTopology.DoldKan.karoubi_pInfty_f

end DoldKan

end AlgebraicTopology


import representation_hom

variables (G : Type*) [group G] (𝕜 : Type*) [field 𝕜]
variables (V : Type*) [add_comm_group V] [has_scalar G V] [vector_space 𝕜 V]
variables (W : Type*) [add_comm_group W] [has_scalar G W] [vector_space 𝕜 W]

variables [rep G 𝕜 V] [rep G 𝕜 W]

definition mono (φ : hom G 𝕜 V W) := ∀ v : V, φ v = 0 → v = 0

definition epi (φ : hom G 𝕜 V W) := ∀ w : W, ∃ v : V, φ v = w

definition iso (φ : hom G 𝕜 V W) := (mono G 𝕜 V W φ) ∧ (epi G 𝕜 V W φ)

definition to_module_hom (φ : hom G 𝕜 V W) : (V →ₗ[𝕜] W) := {
    to_fun := φ.to_fun,
    map_add' := φ.add',
    map_smul' := φ.scalar'
}

definition ker (φ : hom G 𝕜 V W) : subrep G 𝕜 V :=
⟨(to_module_hom G 𝕜 V W φ).ker,
begin
    intros g v,
    cases v with v hv,
    change φ v = 0 at hv,
    change φ (g • v) = 0,
    rw[equivariant,hv,act_zero],
end⟩

definition im (φ : hom G 𝕜 V W) : subrep G 𝕜 W :=
⟨(to_module_hom G 𝕜 V W φ).range,
begin
    intros g w,
    cases w with w hw,
    change ∃ v : V, v ∈ (⊤ : set V) ∧ φ v = w at hw,
    change ∃ v : V, v ∈ (⊤ : set V) ∧ φ v = g • w,
    cases hw with v hv,
    use g • v,
    rw[equivariant,hv.2],
    exact ⟨trivial,rfl⟩,
end⟩

lemma ker_trivial_implies_mono (φ : hom G 𝕜 V W) : ker G 𝕜 V W φ = ⊥ → mono G 𝕜 V W φ :=
begin
    intros hφ v hv,
    change v ∈ ker G 𝕜 V W φ at hv,
    rw hφ at hv,
    exact hv,
end

lemma ker_all_implies_zero (φ : hom G 𝕜 V W) : ker G 𝕜 V W φ = ⊤ → φ = 0 :=
begin
    intro hφ,
    rw ext_iff,
    intro v,
    change v ∈ ker G 𝕜 V W φ,
    rw hφ,
    exact trivial,
end

lemma im_trivial_implies_zero (φ : hom G 𝕜 V W) : im G 𝕜 V W φ = ⊥ → φ = 0 :=
begin
    intro hφ,
    rw ext_iff,
    intro v,
    have hv : φ v ∈ im G 𝕜 V W φ,
    exact ⟨v,⟨trivial,by refl⟩⟩,
    rw hφ at hv,
    exact hv,
end

lemma im_all_implies_epi (φ : hom G 𝕜 V W) : im G 𝕜 V W φ = ⊤ → epi G 𝕜 V W φ :=
begin
    intros hφ w,
    have hw : w ∈ (⊤ : subrep G 𝕜 W),
    exact trivial,
    rw ←hφ at hw,
    cases hw with w hw,
    exact ⟨w,hw.2⟩,
end


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.intervals.unordered_interval
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Order-connected sets

We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α = ℝ`, then
this condition is also equivalent to `convex s`.

In this file we prove that intersection of a family of `ord_connected` sets is `ord_connected` and
that all standard intervals are `ord_connected`.
-/

namespace set

/--
We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α = ℝ`, then
this condition is also equivalent to `convex s`.
-/
def ord_connected {α : Type u_1} [preorder α] (s : set α) :=
  ∀ {x : α}, x ∈ s → ∀ {y : α}, y ∈ s → Icc x y ⊆ s

/-- It suffices to prove `[x, y] ⊆ s` for `x y ∈ s`, `x ≤ y`. -/
theorem ord_connected_iff {α : Type u_1} [preorder α] {s : set α} :
    ord_connected s ↔ ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → x ≤ y → Icc x y ⊆ s :=
  sorry

theorem ord_connected_of_Ioo {α : Type u_1} [partial_order α] {s : set α}
    (hs : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → x < y → Ioo x y ⊆ s) : ord_connected s :=
  sorry

protected theorem Icc_subset {α : Type u_1} [preorder α] (s : set α) [hs : ord_connected s] {x : α}
    {y : α} (hx : x ∈ s) (hy : y ∈ s) : Icc x y ⊆ s :=
  hs hx hy

theorem ord_connected.inter {α : Type u_1} [preorder α] {s : set α} {t : set α}
    (hs : ord_connected s) (ht : ord_connected t) : ord_connected (s ∩ t) :=
  fun (x : α) (hx : x ∈ s ∩ t) (y : α) (hy : y ∈ s ∩ t) =>
    subset_inter (hs (and.left hx) (and.left hy)) (ht (and.right hx) (and.right hy))

protected instance ord_connected.inter' {α : Type u_1} [preorder α] {s : set α} {t : set α}
    [ord_connected s] [ord_connected t] : ord_connected (s ∩ t) :=
  ord_connected.inter _inst_2 _inst_3

theorem ord_connected.dual {α : Type u_1} [preorder α] {s : set α} (hs : ord_connected s) :
    ord_connected s :=
  fun (x : order_dual α) (hx : x ∈ s) (y : order_dual α) (hy : y ∈ s) (z : order_dual α)
    (hz : z ∈ Icc x y) => hs hy hx { left := and.right hz, right := and.left hz }

theorem ord_connected_dual {α : Type u_1} [preorder α] {s : set α} :
    ord_connected s ↔ ord_connected s :=
  { mp := fun (h : ord_connected s) => ord_connected.dual h,
    mpr := fun (h : ord_connected s) => ord_connected.dual h }

theorem ord_connected_sInter {α : Type u_1} [preorder α] {S : set (set α)}
    (hS : ∀ (s : set α), s ∈ S → ord_connected s) : ord_connected (⋂₀S) :=
  fun (x : α) (hx : x ∈ ⋂₀S) (y : α) (hy : y ∈ ⋂₀S) =>
    subset_sInter fun (s : set α) (hs : s ∈ S) => hS s hs (hx s hs) (hy s hs)

theorem ord_connected_Inter {α : Type u_1} [preorder α] {ι : Sort u_2} {s : ι → set α}
    (hs : ∀ (i : ι), ord_connected (s i)) : ord_connected (Inter fun (i : ι) => s i) :=
  ord_connected_sInter (iff.mpr forall_range_iff hs)

protected instance ord_connected_Inter' {α : Type u_1} [preorder α] {ι : Sort u_2} {s : ι → set α}
    [∀ (i : ι), ord_connected (s i)] : ord_connected (Inter fun (i : ι) => s i) :=
  ord_connected_Inter _inst_2

theorem ord_connected_bInter {α : Type u_1} [preorder α] {ι : Sort u_2} {p : ι → Prop}
    {s : (i : ι) → p i → set α} (hs : ∀ (i : ι) (hi : p i), ord_connected (s i hi)) :
    ord_connected (Inter fun (i : ι) => Inter fun (hi : p i) => s i hi) :=
  ord_connected_Inter fun (i : ι) => ord_connected_Inter (hs i)

theorem ord_connected_pi {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)] {s : set ι}
    {t : (i : ι) → set (α i)} (h : ∀ (i : ι), i ∈ s → ord_connected (t i)) :
    ord_connected (pi s t) :=
  fun (x : (i : ι) → α i) (hx : x ∈ pi s t) (y : (i : ι) → α i) (hy : y ∈ pi s t)
    (z : (i : ι) → α i) (hz : z ∈ Icc x y) (i : ι) (hi : i ∈ s) =>
    h i hi (hx i hi) (hy i hi) { left := and.left hz i, right := and.right hz i }

protected instance ord_connected_pi' {ι : Type u_1} {α : ι → Type u_2} [(i : ι) → preorder (α i)]
    {s : set ι} {t : (i : ι) → set (α i)} [h : ∀ (i : ι), ord_connected (t i)] :
    ord_connected (pi s t) :=
  ord_connected_pi fun (i : ι) (hi : i ∈ s) => h i

instance ord_connected_Ici {α : Type u_1} [preorder α] {a : α} : ord_connected (Ici a) :=
  fun (x : α) (hx : x ∈ Ici a) (y : α) (hy : y ∈ Ici a) (z : α) (hz : z ∈ Icc x y) =>
    le_trans hx (and.left hz)

instance ord_connected_Iic {α : Type u_1} [preorder α] {a : α} : ord_connected (Iic a) :=
  fun (x : α) (hx : x ∈ Iic a) (y : α) (hy : y ∈ Iic a) (z : α) (hz : z ∈ Icc x y) =>
    le_trans (and.right hz) hy

instance ord_connected_Ioi {α : Type u_1} [preorder α] {a : α} : ord_connected (Ioi a) :=
  fun (x : α) (hx : x ∈ Ioi a) (y : α) (hy : y ∈ Ioi a) (z : α) (hz : z ∈ Icc x y) =>
    lt_of_lt_of_le hx (and.left hz)

instance ord_connected_Iio {α : Type u_1} [preorder α] {a : α} : ord_connected (Iio a) :=
  fun (x : α) (hx : x ∈ Iio a) (y : α) (hy : y ∈ Iio a) (z : α) (hz : z ∈ Icc x y) =>
    lt_of_le_of_lt (and.right hz) hy

instance ord_connected_Icc {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Icc a b) :=
  ord_connected.inter ord_connected_Ici ord_connected_Iic

instance ord_connected_Ico {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Ico a b) :=
  ord_connected.inter ord_connected_Ici ord_connected_Iio

instance ord_connected_Ioc {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Ioc a b) :=
  ord_connected.inter ord_connected_Ioi ord_connected_Iic

instance ord_connected_Ioo {α : Type u_1} [preorder α] {a : α} {b : α} : ord_connected (Ioo a b) :=
  ord_connected.inter ord_connected_Ioi ord_connected_Iio

instance ord_connected_singleton {α : Type u_1} [partial_order α] {a : α} :
    ord_connected (singleton a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (ord_connected (singleton a))) (Eq.symm (Icc_self a))))
    ord_connected_Icc

instance ord_connected_empty {α : Type u_1} [preorder α] : ord_connected ∅ :=
  fun (x : α) => false.elim

instance ord_connected_univ {α : Type u_1} [preorder α] : ord_connected univ :=
  fun (_x : α) (_x_1 : _x ∈ univ) (_x_2 : α) (_x_3 : _x_2 ∈ univ) => subset_univ (Icc _x _x_2)

/-- In a dense order `α`, the subtype from an `ord_connected` set is also densely ordered. -/
protected instance densely_ordered {α : Type u_1} [preorder α] [densely_ordered α] {s : set α}
    [hs : ord_connected s] : densely_ordered ↥s :=
  densely_ordered.mk
    fun (a₁ a₂ : ↥s) (ha : a₁ < a₂) =>
      Exists.dcases_on (exists_between ha)
        fun (x : α) (h : ↑a₁ < x ∧ x < ↑a₂) =>
          and.dcases_on h
            fun (ha₁x : ↑a₁ < x) (hxa₂ : x < ↑a₂) =>
              Exists.intro
                { val := x,
                  property :=
                    hs (subtype.property a₁) (subtype.property a₂)
                      (Ioo_subset_Icc_self { left := ha₁x, right := hxa₂ }) }
                { left := ha₁x, right := hxa₂ }

instance ord_connected_interval {β : Type u_2} [linear_order β] {a : β} {b : β} :
    ord_connected (interval a b) :=
  ord_connected_Icc

theorem ord_connected.interval_subset {β : Type u_2} [linear_order β] {s : set β}
    (hs : ord_connected s) {x : β} (hx : x ∈ s) {y : β} (hy : y ∈ s) : interval x y ⊆ s :=
  sorry

theorem ord_connected_iff_interval_subset {β : Type u_2} [linear_order β] {s : set β} :
    ord_connected s ↔ ∀ {x : β}, x ∈ s → ∀ {y : β}, y ∈ s → interval x y ⊆ s :=
  sorry

end Mathlib


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

import data.multiset.sort
import data.pnat.interval
import data.rat.order
import data.pnat.basic
import tactic.norm_num
import tactic.field_simp
import tactic.interval_cases

/-!
# The inequality `p⁻¹ + q⁻¹ + r⁻¹ > 1`

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

In this file we classify solutions to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`, for positive natural numbers `p`, `q`, and `r`.

The solutions are exactly of the form.
* `A' q r := {1,q,r}`
* `D' r := {2,2,r}`
* `E6 := {2,3,3}`, or `E7 := {2,3,4}`, or `E8 := {2,3,5}`

This inequality shows up in Lie theory,
in the classification of Dynkin diagrams, root systems, and semisimple Lie algebras.

## Main declarations

* `pqr.A' q r`, the multiset `{1,q,r}`
* `pqr.D' r`, the multiset `{2,2,r}`
* `pqr.E6`, the multiset `{2,3,3}`
* `pqr.E7`, the multiset `{2,3,4}`
* `pqr.E8`, the multiset `{2,3,5}`
* `pqr.classification`, the classification of solutions to `p⁻¹ + q⁻¹ + r⁻¹ > 1`

-/

namespace ADE_inequality

open multiset

/-- `A' q r := {1,q,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`. -/
def A' (q r : ℕ+) : multiset ℕ+ := {1,q,r}

/-- `A r := {1,1,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $A_r$. -/
def A  (r   : ℕ+) : multiset ℕ+ := A' 1 r

/-- `D' r := {2,2,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $D_{r+2}$. -/
def D' (r   : ℕ+) : multiset ℕ+ := {2,2,r}

/-- `E' r := {2,3,r}` is a `multiset ℕ+`.
For `r ∈ {3,4,5}` is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $E_{r+3}$. -/
def E' (r   : ℕ+) : multiset ℕ+ := {2,3,r}

/-- `E6 := {2,3,3}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_6$. -/
def E6            : multiset ℕ+ := E' 3

/-- `E7 := {2,3,4}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_7$. -/
def E7            : multiset ℕ+ := E' 4

/-- `E8 := {2,3,5}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_8$. -/
def E8            : multiset ℕ+ := E' 5

/-- `sum_inv pqr` for a `pqr : multiset ℕ+` is the sum of the inverses
of the elements of `pqr`, as rational number.

The intended argument is a multiset `{p,q,r}` of cardinality `3`. -/
def sum_inv (pqr : multiset ℕ+) : ℚ :=
multiset.sum $ pqr.map $ λ x, x⁻¹

lemma sum_inv_pqr (p q r : ℕ+) : sum_inv {p,q,r} = p⁻¹ + q⁻¹ + r⁻¹ :=
by simp only [sum_inv, coe_coe, add_zero, insert_eq_cons, add_assoc,
    map_cons, sum_cons, map_singleton, sum_singleton]

/-- A multiset `pqr` of positive natural numbers is `admissible`
if it is equal to `A' q r`, or `D' r`, or one of `E6`, `E7`, or `E8`. -/
def admissible (pqr : multiset ℕ+) : Prop :=
  (∃ q r, A' q r = pqr) ∨ (∃ r, D' r = pqr) ∨ (E' 3 = pqr ∨ E' 4 = pqr ∨ E' 5 = pqr)

lemma admissible_A' (q r : ℕ+) : admissible (A' q r) := or.inl ⟨q, r, rfl⟩
lemma admissible_D' (n : ℕ+) : admissible (D' n) := or.inr $ or.inl ⟨n, rfl⟩

lemma admissible_E'3 : admissible (E' 3) := or.inr $ or.inr $ or.inl rfl
lemma admissible_E'4 : admissible (E' 4) := or.inr $ or.inr $ or.inr $ or.inl rfl
lemma admissible_E'5 : admissible (E' 5) := or.inr $ or.inr $ or.inr $ or.inr rfl

lemma admissible.one_lt_sum_inv {pqr : multiset ℕ+} :
  admissible pqr → 1 < sum_inv pqr :=
begin
  rw [admissible],
  rintro (⟨p', q', H⟩|⟨n, H⟩|H|H|H),
  { rw [← H, A', sum_inv_pqr, add_assoc],
    simp only [lt_add_iff_pos_right, pnat.one_coe, inv_one, nat.cast_one, coe_coe],
    apply add_pos; simp only [pnat.pos, nat.cast_pos, inv_pos] },
  { rw [← H, D', sum_inv_pqr],
    simp only [lt_add_iff_pos_right, pnat.one_coe, inv_one, nat.cast_one,
      coe_coe, pnat.coe_bit0, nat.cast_bit0],
    norm_num },
  all_goals { rw [← H, E', sum_inv_pqr], norm_num }
end

lemma lt_three {p q r : ℕ+} (hpq : p ≤ q) (hqr : q ≤ r) (H : 1 < sum_inv {p, q, r}) :
  p < 3 :=
begin
  have h3 : (0:ℚ) < 3, by norm_num,
  contrapose! H, rw sum_inv_pqr,
  have h3q := H.trans hpq,
  have h3r := h3q.trans hqr,
  calc (p⁻¹ + q⁻¹ + r⁻¹ : ℚ) ≤ 3⁻¹ + 3⁻¹ + 3⁻¹ : add_le_add (add_le_add _ _) _
  ... = 1 : by norm_num,
  all_goals { rw inv_le_inv _ h3; [assumption_mod_cast, norm_num] }
end

lemma lt_four {q r : ℕ+} (hqr : q ≤ r) (H : 1 < sum_inv {2, q, r}) :
  q < 4 :=
begin
  have h4 : (0:ℚ) < 4, by norm_num,
  contrapose! H, rw sum_inv_pqr,
  have h4r := H.trans hqr,
  simp only [pnat.coe_bit0, nat.cast_bit0, pnat.one_coe, nat.cast_one, coe_coe],
  calc (2⁻¹ + q⁻¹ + r⁻¹ : ℚ) ≤ 2⁻¹ + 4⁻¹ + 4⁻¹ : add_le_add (add_le_add le_rfl _) _
  ... = 1 : by norm_num,
  all_goals { rw inv_le_inv _ h4; [assumption_mod_cast, norm_num] }
end

lemma lt_six {r : ℕ+} (H : 1 < sum_inv {2, 3, r}) :
  r < 6 :=
begin
  have h6 : (0:ℚ) < 6, by norm_num,
  contrapose! H, rw sum_inv_pqr,
  simp only [pnat.coe_bit0, nat.cast_bit0, pnat.one_coe, nat.cast_bit1, nat.cast_one,
    pnat.coe_bit1, coe_coe],
  calc (2⁻¹ + 3⁻¹ + r⁻¹ : ℚ) ≤ 2⁻¹ + 3⁻¹ + 6⁻¹ : add_le_add (add_le_add le_rfl le_rfl) _
  ... = 1 : by norm_num,
  rw inv_le_inv _ h6; [assumption_mod_cast, norm_num]
end

lemma admissible_of_one_lt_sum_inv_aux' {p q r : ℕ+} (hpq : p ≤ q) (hqr : q ≤ r)
  (H : 1 < sum_inv {p,q,r}) :
  admissible {p,q,r} :=
begin
  have hp3 : p < 3 := lt_three hpq hqr H,
  interval_cases p,
  { exact admissible_A' q r },
  have hq4 : q < 4 := lt_four hqr H,
  interval_cases q,
  { exact admissible_D' r },
  have hr6 : r < 6 := lt_six H,
  interval_cases r,
  { exact admissible_E6 },
  { exact admissible_E7 },
  { exact admissible_E8 }
end

lemma admissible_of_one_lt_sum_inv_aux :
  ∀ {pqr : list ℕ+} (hs : pqr.sorted (≤)) (hl : pqr.length = 3) (H : 1 < sum_inv pqr),
    admissible pqr
| [p,q,r] hs hl H :=
begin
  obtain ⟨⟨hpq, -⟩, hqr⟩ : (p ≤ q ∧ p ≤ r) ∧ q ≤ r,
  simpa using hs,
  exact admissible_of_one_lt_sum_inv_aux' hpq hqr H,
end

lemma admissible_of_one_lt_sum_inv {p q r : ℕ+} (H : 1 < sum_inv {p,q,r}) :
  admissible {p,q,r} :=
begin
  simp only [admissible],
  let S := sort ((≤) : ℕ+ → ℕ+ → Prop) {p,q,r},
  have hS : S.sorted (≤) := sort_sorted _ _,
  have hpqr : ({p,q,r} : multiset ℕ+) = S := (sort_eq has_le.le {p, q, r}).symm,
  simp only [hpqr] at *,
  apply admissible_of_one_lt_sum_inv_aux hS _ H,
  simp only [S, length_sort],
  dec_trivial,
end

/-- A multiset `{p,q,r}` of positive natural numbers
is a solution to `(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1` if and only if
it is `admissible` which means it is one of:

* `A' q r := {1,q,r}`
* `D' r := {2,2,r}`
* `E6 := {2,3,3}`, or `E7 := {2,3,4}`, or `E8 := {2,3,5}`
-/
lemma classification (p q r : ℕ+) :
  1 < sum_inv {p,q,r} ↔ admissible {p,q,r} :=
⟨admissible_of_one_lt_sum_inv, admissible.one_lt_sum_inv⟩

end ADE_inequality


/-
  Relate restriction maps of the structure presheaf to the universal property
  of localization.
-/

import spectrum_of_a_ring.structure_presheaf
import spectrum_of_a_ring.structure_presheaf_localization

universe u

local attribute [instance] classical.prop_decidable

noncomputable theory

open topological_space
open classical
open localization
open localization_alt

section res

-- We are given U and V in {D(f)} and V ⊆ U and we generalize the results that
-- we already proved in properties. We deduce that there's a map from
-- R[1/S(V)] to R[1/S(U)].

variables {R : Type u} [comm_ring R]
variables {U V : opens (Spec R)} (BU : U ∈ D_fs R) (BV : V ∈ D_fs R) (H : V ⊆ U)

include H

-- V ⊆ U → D(g) ⊆ D(f).

lemma Dfs_subset.of_basis_subset
: Spec.DO R (some BV) ⊆ Spec.DO R (some BU) :=
begin
  rw [←some_spec BU, ←some_spec BV],
  exact H,
end

-- V ⊆ U → f ∈ R[1/g]*.

def inverts_data.of_basis_subset.aux
: inverts_data
    (powers (some BU))
    (of : R → localization R (powers (some BV))) :=
begin
  intros s,
  have Hs := inverts.of_Dfs_subset (Dfs_subset.of_basis_subset BU BV H) s,
  rcases (indefinite_description _ Hs) with ⟨si, Hsi⟩,
  exact ⟨si, Hsi⟩,
end

-- V ⊆ U → ∃ a e, g^e = a * f.

def pow_eq.of_basis_subset
: ∃ (a : R) (e : ℕ), (some BV)^e = a * (some BU) :=
pow_eq.of_Dfs_subset (Dfs_subset.of_basis_subset BU BV H)

include BU BV

-- V ⊆ U → S(U) ⊆ R[1/S(V)]*.

def inverts_data.of_basis_subset
: inverts_data
    (S U)
    (of : R → localization R (S V)) :=
begin
  intros s,
  rcases s with ⟨s, Hs⟩,
  change U ⊆ Spec.DO R (s) at Hs,
  have HsV : s ∈ S V := set.subset.trans H Hs,
  use ⟦⟨1, ⟨s, HsV⟩⟩⟧,
  apply quotient.sound,
  use [1, is_submonoid.one_mem _],
  simp,
end

-- The induced map is the restriction map in the structure presheaf.

def structure_presheaf_on_basis.res
: localization R (S U)
→ localization R (S V) :=
is_localization_initial
  (S U)
  (of : R → localization R (S U))
  (of.is_localization_data (S U))
  (of : R → localization R (S V))
  (inverts_data.of_basis_subset BU BV H)

-- Useful.

instance structure_presheaf_on_basis.res.is_ring_hom
: is_ring_hom (structure_presheaf_on_basis.res BU BV H) :=
by simp [structure_presheaf_on_basis.res]; by apply_instance

end res

section res_eq

variables {R : Type u} [comm_ring R]

lemma structure_presheaf_on_basis.res_eq
: (structure_presheaf_on_basis R).res = @structure_presheaf_on_basis.res R _ :=
begin
  apply funext, intro U,
  apply funext, intro V,
  apply funext, intro BU,
  apply funext, intro BV,
  apply funext, intro HVU,
  apply funext, intro x,
  -- x ∈ R[1/S(U)].
  apply quotient.induction_on x,
  rintros ⟨a, b⟩,
  -- Destruct.
  simp [structure_presheaf_on_basis.res, is_localization_initial],
  rcases ((of.is_localization_data (S U)).has_denom ⟦(a, b)⟧) with ⟨⟨q, p⟩, Hpq⟩,
  rcases inverts_data.of_basis_subset BU BV HVU q with ⟨w, Hw⟩,
  dsimp only [subtype.coe_mk] at *,
  revert Hw,
  -- Induction on w.
  apply quotient.induction_on w,
  rintros ⟨c, d⟩ Hw,
  apply quotient.sound,
  erw quotient.eq at Hpq,
  erw quotient.eq at Hw,
  rcases Hpq with ⟨t, ⟨Ht, Hpq⟩⟩;
  simp [-sub_eq_add_neg, sub_mul, sub_eq_zero] at Hpq,
  rcases Hw with ⟨s, ⟨Hs, Hw⟩⟩;
  simp [-sub_eq_add_neg, sub_mul, sub_eq_zero] at Hw,
  -- Kill it.
  replace Ht := (S.rev_mono HVU) Ht,
  use [s * t, is_submonoid.mul_mem Hs Ht],
  simp [-sub_eq_add_neg],
  rw sub_mul,
  rw sub_eq_zero,
  repeat { rw ←mul_assoc, },
  iterate 2 { rw [mul_assoc _ _ t, mul_comm _ t, ←mul_assoc] },
  erw Hpq,
  symmetry,
  iterate 1 { rw [mul_assoc _ _ s, mul_comm _ s, ←mul_assoc] },
  rw Hw,
  ring,
end

lemma structure_presheaf_on_basis.res_comp
{U V W : opens (Spec R)} (BU : U ∈ D_fs R) (BV : V ∈ D_fs R) (BW : W ∈ D_fs R)
(HVU : V ⊆ U) (HWV : W ⊆ V)
: structure_presheaf_on_basis.res BU BW (set.subset.trans HWV HVU)
= structure_presheaf_on_basis.res BV BW HWV ∘ structure_presheaf_on_basis.res BU BV HVU :=
begin
  rw ←structure_presheaf_on_basis.res_eq,
  rw (structure_presheaf_on_basis R).Hcomp,
end

lemma structure_presheaf_on_basis.res_comp_of
{U V : opens (Spec R)} (BU : U ∈ D_fs R) (BV : V ∈ D_fs R) (H : V ⊆ U)
: (of : R → localization R (S (V)))
= structure_presheaf_on_basis.res BU BV H ∘ (of : R → localization R (S (U))) :=
begin
  apply funext, intro x,
  simp [structure_presheaf_on_basis.res],
  rw is_localization_initial_comp,
end

lemma structure_presheaf_on_basis.res_comp_of'
{U V : opens (Spec R)} (BU : U ∈ D_fs R) (BV : V ∈ D_fs R) (H : V ⊆ U)
: ∀ x,
(of : R → localization R (S (V))) x
= structure_presheaf_on_basis.res BU BV H ((of : R → localization R (S (U))) x) :=
begin
  intros x,
  rw structure_presheaf_on_basis.res_comp_of BU BV H,
end

end res_eq


/-
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, Mario Carneiro, Yury Kudryashov
-/
import order.liminf_limsup
import topology.algebra.order.basic

/-!
# Lemmas about liminf and limsup in an order topology.
-/

open filter
open_locale topological_space classical

universes u v
variables {α : Type u} {β : Type v}

section liminf_limsup

section order_closed_topology
variables [semilattice_sup α] [topological_space α] [order_topology α]

lemma is_bounded_le_nhds (a : α) : (𝓝 a).is_bounded (≤) :=
match forall_le_or_exists_lt_sup a with
| or.inl h := ⟨a, eventually_of_forall h⟩
| or.inr ⟨b, hb⟩ := ⟨b, ge_mem_nhds hb⟩
end

lemma filter.tendsto.is_bounded_under_le {f : filter β} {u : β → α} {a : α}
  (h : tendsto u f (𝓝 a)) : f.is_bounded_under (≤) u :=
(is_bounded_le_nhds a).mono h

lemma filter.tendsto.bdd_above_range_of_cofinite {u : β → α} {a : α}
  (h : tendsto u cofinite (𝓝 a)) : bdd_above (set.range u) :=
h.is_bounded_under_le.bdd_above_range_of_cofinite

lemma filter.tendsto.bdd_above_range {u : ℕ → α} {a : α}
  (h : tendsto u at_top (𝓝 a)) : bdd_above (set.range u) :=
h.is_bounded_under_le.bdd_above_range

lemma is_cobounded_ge_nhds (a : α) : (𝓝 a).is_cobounded (≥) :=
(is_bounded_le_nhds a).is_cobounded_flip

lemma filter.tendsto.is_cobounded_under_ge {f : filter β} {u : β → α} {a : α}
  [ne_bot f] (h : tendsto u f (𝓝 a)) : f.is_cobounded_under (≥) u :=
h.is_bounded_under_le.is_cobounded_flip

end order_closed_topology

section order_closed_topology
variables [semilattice_inf α] [topological_space α] [order_topology α]

lemma is_bounded_ge_nhds (a : α) : (𝓝 a).is_bounded (≥) :=
@is_bounded_le_nhds (order_dual α) _ _ _ a

lemma filter.tendsto.is_bounded_under_ge {f : filter β} {u : β → α} {a : α}
  (h : tendsto u f (𝓝 a)) : f.is_bounded_under (≥) u :=
(is_bounded_ge_nhds a).mono h

lemma filter.tendsto.bdd_below_range_of_cofinite {u : β → α} {a : α}
  (h : tendsto u cofinite (𝓝 a)) : bdd_below (set.range u) :=
h.is_bounded_under_ge.bdd_below_range_of_cofinite

lemma filter.tendsto.bdd_below_range {u : ℕ → α} {a : α}
  (h : tendsto u at_top (𝓝 a)) : bdd_below (set.range u) :=
h.is_bounded_under_ge.bdd_below_range

lemma is_cobounded_le_nhds (a : α) : (𝓝 a).is_cobounded (≤) :=
(is_bounded_ge_nhds a).is_cobounded_flip

lemma filter.tendsto.is_cobounded_under_le {f : filter β} {u : β → α} {a : α}
  [ne_bot f] (h : tendsto u f (𝓝 a)) : f.is_cobounded_under (≤) u :=
h.is_bounded_under_ge.is_cobounded_flip

end order_closed_topology

section conditionally_complete_linear_order
variables [conditionally_complete_linear_order α]

theorem lt_mem_sets_of_Limsup_lt {f : filter α} {b} (h : f.is_bounded (≤)) (l : f.Limsup < b) :
  ∀ᶠ a in f, a < b :=
let ⟨c, (h : ∀ᶠ a in f, a ≤ c), hcb⟩ := exists_lt_of_cInf_lt h l in
mem_of_superset h $ assume a hac, lt_of_le_of_lt hac hcb

theorem gt_mem_sets_of_Liminf_gt : ∀ {f : filter α} {b}, f.is_bounded (≥) → b < f.Liminf →
  ∀ᶠ a in f, b < a :=
@lt_mem_sets_of_Limsup_lt (order_dual α) _

variables [topological_space α] [order_topology α]

/-- If the liminf and the limsup of a filter coincide, then this filter converges to
their common value, at least if the filter is eventually bounded above and below. -/
theorem le_nhds_of_Limsup_eq_Liminf {f : filter α} {a : α}
  (hl : f.is_bounded (≤)) (hg : f.is_bounded (≥)) (hs : f.Limsup = a) (hi : f.Liminf = a) :
  f ≤ 𝓝 a :=
tendsto_order.2 $ and.intro
  (assume b hb, gt_mem_sets_of_Liminf_gt hg $ hi.symm ▸ hb)
  (assume b hb, lt_mem_sets_of_Limsup_lt hl $ hs.symm ▸ hb)

theorem Limsup_nhds (a : α) : Limsup (𝓝 a) = a :=
cInf_eq_of_forall_ge_of_forall_gt_exists_lt (is_bounded_le_nhds a)
  (assume a' (h : {n : α | n ≤ a'} ∈ 𝓝 a), show a ≤ a', from @mem_of_mem_nhds α _ a _ h)
  (assume b (hba : a < b), show ∃c (h : {n : α | n ≤ c} ∈ 𝓝 a), c < b, from
    match dense_or_discrete a b with
    | or.inl ⟨c, hac, hcb⟩ := ⟨c, ge_mem_nhds hac, hcb⟩
    | or.inr ⟨_, h⟩        := ⟨a, (𝓝 a).sets_of_superset (gt_mem_nhds hba) h, hba⟩
    end)

theorem Liminf_nhds : ∀ (a : α), Liminf (𝓝 a) = a :=
@Limsup_nhds (order_dual α) _ _ _

/-- If a filter is converging, its limsup coincides with its limit. -/
theorem Liminf_eq_of_le_nhds {f : filter α} {a : α} [ne_bot f] (h : f ≤ 𝓝 a) : f.Liminf = a :=
have hb_ge : is_bounded (≥) f, from (is_bounded_ge_nhds a).mono h,
have hb_le : is_bounded (≤) f, from (is_bounded_le_nhds a).mono h,
le_antisymm
  (calc f.Liminf ≤ f.Limsup : Liminf_le_Limsup hb_le hb_ge
    ... ≤ (𝓝 a).Limsup :
      Limsup_le_Limsup_of_le h hb_ge.is_cobounded_flip (is_bounded_le_nhds a)
    ... = a : Limsup_nhds a)
  (calc a = (𝓝 a).Liminf : (Liminf_nhds a).symm
    ... ≤ f.Liminf :
      Liminf_le_Liminf_of_le h (is_bounded_ge_nhds a) hb_le.is_cobounded_flip)

/-- If a filter is converging, its liminf coincides with its limit. -/
theorem Limsup_eq_of_le_nhds : ∀ {f : filter α} {a : α} [ne_bot f], f ≤ 𝓝 a → f.Limsup = a :=
@Liminf_eq_of_le_nhds (order_dual α) _ _ _

/-- If a function has a limit, then its limsup coincides with its limit. -/
theorem filter.tendsto.limsup_eq {f : filter β} {u : β → α} {a : α} [ne_bot f]
  (h : tendsto u f (𝓝 a)) : limsup f u = a :=
Limsup_eq_of_le_nhds h

/-- If a function has a limit, then its liminf coincides with its limit. -/
theorem filter.tendsto.liminf_eq {f : filter β} {u : β → α} {a : α} [ne_bot f]
  (h : tendsto u f (𝓝 a)) : liminf f u = a :=
Liminf_eq_of_le_nhds h

/-- If the liminf and the limsup of a function coincide, then the limit of the function
exists and has the same value -/
theorem tendsto_of_liminf_eq_limsup {f : filter β} {u : β → α} {a : α}
  (hinf : liminf f u = a) (hsup : limsup f u = a)
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  tendsto u f (𝓝 a) :=
le_nhds_of_Limsup_eq_Liminf h h' hsup hinf

/-- If a number `a` is less than or equal to the `liminf` of a function `f` at some filter
and is greater than or equal to the `limsup` of `f`, then `f` tends to `a` along this filter. -/
theorem tendsto_of_le_liminf_of_limsup_le {f : filter β} {u : β → α} {a : α}
  (hinf : a ≤ liminf f u) (hsup : limsup f u ≤ a)
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  tendsto u f (𝓝 a) :=
if hf : f = ⊥ then hf.symm ▸ tendsto_bot
else by haveI : ne_bot f := ⟨hf⟩; exact tendsto_of_liminf_eq_limsup
  (le_antisymm (le_trans (liminf_le_limsup h h') hsup) hinf)
  (le_antisymm hsup (le_trans hinf (liminf_le_limsup h h'))) h h'

/-- Assume that, for any `a < b`, a sequence can not be infinitely many times below `a` and
above `b`. If it is also ultimately bounded above and below, then it has to converge. This even
works if `a` and `b` are restricted to a dense subset.
-/
lemma tendsto_of_no_upcrossings [densely_ordered α]
  {f : filter β} {u : β → α} {s : set α} (hs : dense s)
  (H : ∀ (a ∈ s) (b ∈ s), a < b → ¬((∃ᶠ n in f, u n < a) ∧ (∃ᶠ n in f, b < u n)))
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  ∃ (c : α), tendsto u f (𝓝 c) :=
begin
  by_cases hbot : f = ⊥, { rw hbot, exact ⟨Inf ∅, tendsto_bot⟩ },
  haveI : ne_bot f := ⟨hbot⟩,
  refine ⟨limsup f u, _⟩,
  apply tendsto_of_le_liminf_of_limsup_le _ le_rfl h h',
  by_contra' hlt,
  obtain ⟨a, ⟨⟨la, au⟩, as⟩⟩ : ∃ a, (f.liminf u < a ∧ a < f.limsup u) ∧ a ∈ s :=
    dense_iff_inter_open.1 hs (set.Ioo (f.liminf u) (f.limsup u)) is_open_Ioo
    (set.nonempty_Ioo.2 hlt),
  obtain ⟨b, ⟨⟨ab, bu⟩, bs⟩⟩ : ∃ b, (a < b ∧ b < f.limsup u) ∧ b ∈ s :=
    dense_iff_inter_open.1 hs (set.Ioo a (f.limsup u)) is_open_Ioo
    (set.nonempty_Ioo.2 au),
  have A : ∃ᶠ n in f, u n < a :=
    frequently_lt_of_liminf_lt (is_bounded.is_cobounded_ge h) la,
  have B : ∃ᶠ n in f, b < u n :=
    frequently_lt_of_lt_limsup (is_bounded.is_cobounded_le h') bu,
  exact H a as b bs ab ⟨A, B⟩,
end

end conditionally_complete_linear_order

end liminf_limsup