/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.category.Top.opens

/-!
# The category of open neighborhoods of a point

Given an object `X` of the category `Top` of topological spaces and a point `x : X`, this file
builds the type `open_nhds x` of open neighborhoods of `x` in `X` and endows it with the partial
order given by inclusion and the corresponding category structure (as a full subcategory of the
poset category `set X`). This is used in `topology.sheaves.stalks` to build the stalk of a sheaf
at `x` as a limit over `open_nhds x`.

## Main declarations

Besides `open_nhds`, the main constructions here are:

* `inclusion (x : X)`: the obvious functor `open_nhds x ⥤ opens X`
* `functor_nhds`: An open map `f : X ⟶ Y` induces a functor `open_nhds x ⥤ open_nhds (f x)`
* `adjunction_nhds`: An open map `f : X ⟶ Y` induces an adjunction between `open_nhds x` and
                     `open_nhds (f x)`.
-/

open category_theory
open topological_space
open opposite

universe u

variables {X Y : Top.{u}} (f : X ⟶ Y)

namespace topological_space

/-- The type of open neighbourhoods of a point `x` in a (bundled) topological space. -/
def open_nhds (x : X) := full_subcategory (λ (U : opens X), x ∈ U)

namespace open_nhds

instance (x : X) : partial_order (open_nhds x) :=
{ le := λ U V, U.1 ≤ V.1,
  le_refl := λ _, le_rfl,
  le_trans := λ _ _ _, le_trans,
  le_antisymm := λ _ _ i j, full_subcategory.ext _ _ $ le_antisymm i j }

instance (x : X) : lattice (open_nhds x) :=
{ inf := λ U V, ⟨U.1 ⊓ V.1, ⟨U.2, V.2⟩⟩,
  le_inf := λ U V W, @le_inf _ _ U.1.1 V.1.1 W.1.1,
  inf_le_left := λ U V, @inf_le_left _ _ U.1.1 V.1.1,
  inf_le_right := λ U V, @inf_le_right _ _ U.1.1 V.1.1,
  sup := λ U V, ⟨U.1 ⊔ V.1, V.1.1.mem_union_left U.2⟩,
  sup_le := λ U V W, @sup_le _ _ U.1.1 V.1.1 W.1.1,
  le_sup_left := λ U V, @le_sup_left _ _ U.1.1 V.1.1,
  le_sup_right := λ U V, @le_sup_right _ _ U.1.1 V.1.1,
  ..open_nhds.partial_order x }

instance (x : X) : order_top (open_nhds x) :=
{ top := ⟨⊤, trivial⟩,
  le_top := λ _, le_top }

instance (x : X) : inhabited (open_nhds x) := ⟨⊤⟩

instance open_nhds_category (x : X) : category.{u} (open_nhds x) :=
by {unfold open_nhds, apply_instance}

instance opens_nhds_hom_has_coe_to_fun {x : X} {U V : open_nhds x} :
  has_coe_to_fun (U ⟶ V) (λ _, U.1 → V.1) :=
⟨λ f x, ⟨x, f.le x.2⟩⟩

/--
The inclusion `U ⊓ V ⟶ U` as a morphism in the category of open sets.
-/
def inf_le_left {x : X} (U V : open_nhds x) : U ⊓ V ⟶ U :=
hom_of_le inf_le_left

/--
The inclusion `U ⊓ V ⟶ V` as a morphism in the category of open sets.
-/
def inf_le_right {x : X} (U V : open_nhds x) : U ⊓ V ⟶ V :=
hom_of_le inf_le_right

/-- The inclusion functor from open neighbourhoods of `x`
to open sets in the ambient topological space. -/
def inclusion (x : X) : open_nhds x ⥤ opens X :=
full_subcategory_inclusion _

@[simp] lemma inclusion_obj (x : X) (U) (p) : (inclusion x).obj ⟨U,p⟩ = U := rfl

lemma open_embedding {x : X} (U : open_nhds x) : open_embedding (U.1.inclusion) :=
U.1.open_embedding

/-- The preimage functor from neighborhoods of `f x` to neighborhoods of `x`. -/
def map (x : X) : open_nhds (f x) ⥤ open_nhds x :=
{ obj := λ U, ⟨(opens.map f).obj U.1, U.2⟩,
  map := λ U V i, (opens.map f).map i }

@[simp] lemma map_obj (x : X) (U) (q) : (map f x).obj ⟨U, q⟩ = ⟨(opens.map f).obj U, by tidy⟩ :=
rfl
@[simp] lemma map_id_obj (x : X) (U) : (map (𝟙 X) x).obj U = U :=
by tidy
@[simp] lemma map_id_obj' (x : X) (U) (p) (q) : (map (𝟙 X) x).obj ⟨⟨U, p⟩, q⟩ = ⟨⟨U, p⟩, q⟩ :=
rfl

@[simp] lemma map_id_obj_unop (x : X) (U : (open_nhds x)ᵒᵖ) : (map (𝟙 X) x).obj (unop U) = unop U :=
by simp
@[simp] lemma op_map_id_obj (x : X) (U : (open_nhds x)ᵒᵖ) : (map (𝟙 X) x).op.obj U = U :=
by simp

/-- `opens.map f` and `open_nhds.map f` form a commuting square (up to natural isomorphism)
with the inclusion functors into `opens X`. -/
def inclusion_map_iso (x : X) : inclusion (f x) ⋙ opens.map f ≅ map f x ⋙ inclusion x :=
nat_iso.of_components
  (λ U, begin split, exact 𝟙 _, exact 𝟙 _ end)
  (by tidy)

@[simp] lemma inclusion_map_iso_hom (x : X) : (inclusion_map_iso f x).hom = 𝟙 _ := rfl
@[simp] lemma inclusion_map_iso_inv (x : X) : (inclusion_map_iso f x).inv = 𝟙 _ := rfl

end open_nhds

end topological_space

namespace is_open_map

open topological_space

variables {f}

/--
An open map `f : X ⟶ Y` induces a functor `open_nhds x ⥤ open_nhds (f x)`.
-/
@[simps]
def functor_nhds (h : is_open_map f) (x : X) :
  open_nhds x ⥤ open_nhds (f x) :=
{ obj := λ U, ⟨h.functor.obj U.1, ⟨x, U.2, rfl⟩⟩,
  map := λ U V i, h.functor.map i }

/--
An open map `f : X ⟶ Y` induces an adjunction between `open_nhds x` and `open_nhds (f x)`.
-/
def adjunction_nhds (h : is_open_map f) (x : X) :
  is_open_map.functor_nhds h x ⊣ open_nhds.map f x :=
adjunction.mk_of_unit_counit
{ unit := { app := λ U, hom_of_le $ λ x hxU, ⟨x, hxU, rfl⟩ },
  counit := { app := λ V, hom_of_le $ λ y ⟨x, hfxV, hxy⟩, hxy ▸ hfxV } }

end is_open_map


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.SimpLemmas
import Init.Data.Nat.Basic
open Decidable List

universes u v w

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

namespace List

@[simp] theorem length_nil : length ([] : List α) = 0 :=
  rfl

def reverseAux : List α → List α → List α
  | [],   r => r
  | a::l, r => reverseAux l (a::r)

def reverse (as : List α) :List α :=
  reverseAux as []

protected def append (as bs : List α) : List α :=
  reverseAux as.reverse bs

instance : Append (List α) := ⟨List.append⟩

theorem reverseAux_reverseAux_nil (as bs : List α) : reverseAux (reverseAux as bs) [] = reverseAux bs as := by
  induction as generalizing bs with
  | nil => rfl
  | cons a as ih => simp [reverseAux, ih]

@[simp] theorem nil_append (as : List α) : [] ++ as = as := rfl

@[simp] theorem append_nil (as : List α) : as ++ [] = as := by
  show reverseAux (reverseAux as []) [] = as
  simp [reverseAux_reverseAux_nil, reverseAux]

theorem reverseAux_reverseAux (as bs cs : List α) : reverseAux (reverseAux as bs) cs = reverseAux bs (reverseAux (reverseAux as []) cs) := by
  induction as generalizing bs cs with
  | nil => rfl
  | cons a as ih => simp [reverseAux, ih (a::bs), ih [a]]

@[simp] theorem cons_append (a : α) (as bs : List α) : (a::as) ++ bs = a::(as ++ bs) :=
  reverseAux_reverseAux as [a] bs

theorem append_assoc (as bs cs : List α) : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by
  induction as with
  | nil => rfl
  | cons a as ih => simp [ih]

instance : EmptyCollection (List α) := ⟨List.nil⟩

protected def erase {α} [BEq α] : List α → α → List α
  | [],    b => []
  | a::as, b => match a == b with
    | true  => as
    | false => a :: List.erase as b

def eraseIdx : List α → Nat → List α
  | [],    _   => []
  | a::as, 0   => as
  | a::as, n+1 => a :: eraseIdx as n

def isEmpty : List α → Bool
  | []     => true
  | _ :: _ => false

@[specialize] def map (f : α → β) : List α → List β
  | []    => []
  | a::as => f a :: map f as

@[specialize] def map₂ (f : α → β → γ) : List α → List β → List γ
  | [],    _     => []
  | _,     []    => []
  | a::as, b::bs => f a b :: map₂ f as bs

def join : List (List α) → List α
  | []      => []
  | a :: as => a ++ join as

@[specialize] def filterMap (f : α → Option β) : List α → List β
  | []   => []
  | a::as =>
    match f a with
    | none   => filterMap f as
    | some b => b :: filterMap f as

@[specialize] def filterAux (p : α → Bool) : List α → List α → List α
  | [],    rs => rs.reverse
  | a::as, rs => match p a with
     | true  => filterAux p as (a::rs)
     | false => filterAux p as rs

@[inline] def filter (p : α → Bool) (as : List α) : List α :=
  filterAux p as []

@[specialize] def partitionAux (p : α → Bool) : List α → List α × List α → List α × List α
  | [],    (bs, cs) => (bs.reverse, cs.reverse)
  | a::as, (bs, cs) =>
    match p a with
    | true  => partitionAux p as (a::bs, cs)
    | false => partitionAux p as (bs, a::cs)

@[inline] def partition (p : α → Bool) (as : List α) : List α × List α :=
  partitionAux p as ([], [])

def dropWhile (p : α → Bool) : List α → List α
  | []   => []
  | a::l => match p a with
    | true  => dropWhile p l
    | false =>  a::l

def find? (p : α → Bool) : List α → Option α
  | []    => none
  | a::as => match p a with
    | true  => some a
    | false => find? p as

def findSome? (f : α → Option β) : List α → Option β
  | []    => none
  | a::as => match f a with
    | some b => some b
    | none   => findSome? f as

def replace [BEq α] : List α → α → α → List α
  | [],    _, _ => []
  | a::as, b, c => match a == b with
    | true  => c::as
    | false => a :: (replace as b c)

def elem [BEq α] (a : α) : List α → Bool
  | []    => false
  | b::bs => match a == b with
    | true  => true
    | false => elem a bs

def notElem [BEq α] (a : α) (as : List α) : Bool :=
  !(as.elem a)

abbrev contains [BEq α] (as : List α) (a : α) : Bool :=
  elem a as

def eraseDupsAux {α} [BEq α] : List α → List α → List α
  | [],    bs => bs.reverse
  | a::as, bs => match bs.elem a with
    | true  => eraseDupsAux as bs
    | false => eraseDupsAux as (a::bs)

def eraseDups {α} [BEq α] (as : List α) : List α :=
  eraseDupsAux as []

def eraseRepsAux {α} [BEq α] : α → List α → List α → List α
  | a, [], rs => (a::rs).reverse
  | a, a'::as, rs => match a == a' with
    | true  => eraseRepsAux a as rs
    | false => eraseRepsAux a' as (a::rs)

/-- Erase repeated adjacent elements. -/
def eraseReps {α} [BEq α] : List α → List α
  | []    => []
  | a::as => eraseRepsAux a as []

@[specialize] def spanAux (p : α → Bool) : List α → List α → List α × List α
  | [],    rs => (rs.reverse, [])
  | a::as, rs => match p a with
    | true  => spanAux p as (a::rs)
    | false => (rs.reverse, a::as)

@[inline] def span (p : α → Bool) (as : List α) : List α × List α :=
  spanAux p as []

@[specialize] def groupByAux (eq : α → α → Bool) : List α → List (List α) → List (List α)
  | a::as, (ag::g)::gs => match eq a ag with
    | true  => groupByAux eq as ((a::ag::g)::gs)
    | false => groupByAux eq as ([a]::(ag::g).reverse::gs)
  | _, gs => gs.reverse

@[specialize] def groupBy (p : α → α → Bool) : List α → List (List α)
  | []    => []
  | a::as => groupByAux p as [[a]]

def lookup [BEq α] : α → List (α × β) → Option β
  | _, []        => none
  | a, (k,b)::es => match a == k with
    | true  => some b
    | false => lookup a es

def removeAll [BEq α] (xs ys : List α) : List α :=
  xs.filter (fun x => ys.notElem x)

def drop : Nat → List α → List α
  | 0,   a     => a
  | n+1, []    => []
  | n+1, a::as => drop n as

def take : Nat → List α → List α
  | 0,   a     => []
  | n+1, []    => []
  | n+1, a::as => a :: take n as

@[specialize] def foldr (f : α → β → β) (init : β) : List α → β
  | []     => init
  | a :: l => f a (foldr f init l)

@[inline] def any (l : List α) (p : α → Bool) : Bool :=
  foldr (fun a r => p a || r) false l

@[inline] def all (l : List α) (p : α → Bool) : Bool :=
  foldr (fun a r => p a && r) true l

def or  (bs : List Bool) : Bool := bs.any id

def and (bs : List Bool) : Bool := bs.all id

def zipWith (f : α → β → γ) : List α → List β → List γ
  | x::xs, y::ys => f x y :: zipWith f xs ys
  | _,     _     => []

def zip : List α → List β → List (Prod α β) :=
  zipWith Prod.mk

def unzip : List (α × β) → List α × List β
  | []          => ([], [])
  | (a, b) :: t => match unzip t with | (al, bl) => (a::al, b::bl)

def rangeAux : Nat → List Nat → List Nat
  | 0,   ns => ns
  | n+1, ns => rangeAux n (n::ns)

def range (n : Nat) : List Nat :=
  rangeAux n []

def iota : Nat → List Nat
  | 0       => []
  | m@(n+1) => m :: iota n

def enumFrom : Nat → List α → List (Nat × α)
  | n, [] => nil
  | n, x :: xs   => (n, x) :: enumFrom (n + 1) xs

def enum : List α → List (Nat × α) := enumFrom 0

def init : List α → List α
  | []   => []
  | [a]  => []
  | a::l => a::init l

def intersperse (sep : α) : List α → List α
  | []    => []
  | [x]   => [x]
  | x::xs => x :: sep :: intersperse sep xs

def intercalate (sep : List α) (xs : List (List α)) : List α :=
  join (intersperse sep xs)

@[inline] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := join (map b a)

@[inline] protected def pure {α : Type u} (a : α) : List α := [a]

inductive lt [LT α] : List α → List α → Prop where
  | nil  (b : α) (bs : List α) : lt [] (b::bs)
  | head {a : α} (as : List α) {b : α} (bs : List α) : a < b → lt (a::as) (b::bs)
  | tail {a : α} {as : List α} {b : α} {bs : List α} : ¬ a < b → ¬ b < a → lt as bs → lt (a::as) (b::bs)

instance [LT α] : LT (List α) := ⟨List.lt⟩

instance hasDecidableLt [LT α] [h : DecidableRel (α:=α) (·<·)] : (l₁ l₂ : List α) → Decidable (l₁ < l₂)
  | [],    []    => isFalse (fun h => nomatch h)
  | [],    b::bs => isTrue (List.lt.nil _ _)
  | a::as, []    => isFalse (fun h => nomatch h)
  | a::as, b::bs =>
    match h a b with
    | isTrue h₁  => isTrue (List.lt.head _ _ h₁)
    | isFalse h₁ =>
      match h b a with
      | isTrue h₂  => isFalse (fun h => match h with
         | List.lt.head _ _ h₁' => absurd h₁' h₁
         | List.lt.tail _ h₂' _ => absurd h₂ h₂')
      | isFalse h₂ =>
        match hasDecidableLt as bs with
        | isTrue h₃  => isTrue (List.lt.tail h₁ h₂ h₃)
        | isFalse h₃ => isFalse (fun h => match h with
           | List.lt.head _ _ h₁' => absurd h₁' h₁
           | List.lt.tail _ _ h₃' => absurd h₃' h₃)

@[reducible] protected def le [LT α] (a b : List α) : Prop := ¬ b < a

instance [LT α] : LE (List α) := ⟨List.le⟩

instance [LT α] [h : DecidableRel ((· < ·) : α → α → Prop)] : (l₁ l₂ : List α) → Decidable (l₁ ≤ l₂) :=
  fun a b => inferInstanceAs (Decidable (Not _))

/--  `isPrefixOf l₁ l₂` returns `true` Iff `l₁` is a prefix of `l₂`. -/
def isPrefixOf [BEq α] : List α → List α → Bool
  | [],    _     => true
  | _,     []    => false
  | a::as, b::bs => a == b && isPrefixOf as bs

/--  `isSuffixOf l₁ l₂` returns `true` Iff `l₁` is a suffix of `l₂`. -/
def isSuffixOf [BEq α] (l₁ l₂ : List α) : Bool :=
  isPrefixOf l₁.reverse l₂.reverse

@[specialize] def isEqv : List α → List α → (α → α → Bool) → Bool
  | [],    [],    _   => true
  | a::as, b::bs, eqv => eqv a b && isEqv as bs eqv
  | _,     _,     eqv => false

protected def beq [BEq α] : List α → List α → Bool
  | [],    []    => true
  | a::as, b::bs => a == b && List.beq as bs
  | _,     _     => false

instance [BEq α] : BEq (List α) := ⟨List.beq⟩

def replicate {α : Type u} (n : Nat) (a : α) : List α :=
  let rec loop : Nat → List α → List α
    | 0, as => as
    | n+1, as => loop n (a::as)
  loop n []

def dropLast {α} : List α → List α
  | []    => []
  | [a]   => []
  | a::as => a :: dropLast as

@[simp] theorem length_replicate (n : Nat) (a : α) : (replicate n a).length = n :=
  let rec aux (n : Nat) (as : List α) : (replicate.loop a n as).length = n + as.length := by
    induction n generalizing as with
    | zero => simp [replicate.loop]
    | succ n ih => simp [replicate.loop, ih, Nat.succ_add, Nat.add_succ]
  aux n []

@[simp] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
  induction as with
  | nil => rfl
  | cons x xs ih => simp [concat, ih]

@[simp] theorem length_set (as : List α) (i : Nat) (a : α) : (as.set i a).length = as.length := by
  induction as generalizing i with
  | nil => rfl
  | cons x xs ih =>
    cases i with
    | zero => rfl
    | succ i => simp [set, ih]

@[simp] theorem length_dropLast (as : List α) : as.dropLast.length = as.length - 1 := by
  match as with
  | []       => rfl
  | [a]      => rfl
  | a::b::as =>
    have ih := length_dropLast (b::as)
    simp[dropLast, ih]
    rfl

end List


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Scott Morrison, Floris van Doorn
-/
import category_theory.adjunction.basic
import category_theory.limits.cones

/-!
# Limits and colimits

We set up the general theory of limits and colimits in a category.
In this introduction we only describe the setup for limits;
it is repeated, with slightly different names, for colimits.

The main structures defined in this file is
* `is_limit c`, for `c : cone F`, `F : J ⥤ C`, expressing that `c` is a limit cone,

See also `category_theory.limits.has_limits` which further builds:
* `limit_cone F`, which consists of a choice of cone for `F` and the fact it is a limit cone, and
* `has_limit F`, asserting the mere existence of some limit cone for `F`.

## Implementation
At present we simply say everything twice, in order to handle both limits and colimits.
It would be highly desirable to have some automation support,
e.g. a `@[dualize]` attribute that behaves similarly to `@[to_additive]`.

## References
* [Stacks: Limits and colimits](https://stacks.math.columbia.edu/tag/002D)

-/

noncomputable theory

open category_theory category_theory.category category_theory.functor opposite

namespace category_theory.limits

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variables {J : Type u₁} [category.{v₁} J] {K : Type u₂} [category.{v₂} K]
variables {C : Type u₃} [category.{v₃} C]

variables {F : J ⥤ C}

/--
A cone `t` on `F` is a limit cone if each cone on `F` admits a unique
cone morphism to `t`.

See <https://stacks.math.columbia.edu/tag/002E>.
  -/
@[nolint has_inhabited_instance]
structure is_limit (t : cone F) :=
(lift  : Π (s : cone F), s.X ⟶ t.X)
(fac'  : ∀ (s : cone F) (j : J), lift s ≫ t.π.app j = s.π.app j . obviously)
(uniq' : ∀ (s : cone F) (m : s.X ⟶ t.X) (w : ∀ j : J, m ≫ t.π.app j = s.π.app j),
  m = lift s . obviously)

restate_axiom is_limit.fac'
attribute [simp, reassoc] is_limit.fac
restate_axiom is_limit.uniq'

namespace is_limit

instance subsingleton {t : cone F} : subsingleton (is_limit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cone point
of any cone over `F` to the cone point of a limit cone over `G`. -/
def map {F G : J ⥤ C} (s : cone F) {t : cone G} (P : is_limit t)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.lift ((cones.postcompose α).obj s)

@[simp, reassoc] lemma map_π {F G : J ⥤ C} (c : cone F) {d : cone G} (hd : is_limit d)
  (α : F ⟶ G) (j : J) : hd.map c α ≫ d.π.app j = c.π.app j ≫ α.app j :=
fac _ _ _

lemma lift_self {c : cone F} (t : is_limit c) : t.lift c = 𝟙 c.X :=
(t.uniq _ _ (λ j, id_comp _)).symm

/- Repackaging the definition in terms of cone morphisms. -/

/-- The universal morphism from any other cone to a limit cone. -/
@[simps]
def lift_cone_morphism {t : cone F} (h : is_limit t) (s : cone F) : s ⟶ t :=
{ hom := h.lift s }

lemma uniq_cone_morphism {s t : cone F} (h : is_limit t) {f f' : s ⟶ t} :
  f = f' :=
have ∀ {g : s ⟶ t}, g = h.lift_cone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/-- Restating the definition of a limit cone in terms of the ∃! operator. -/
lemma exists_unique {t : cone F} (h : is_limit t) (s : cone F) :
  ∃! (l : s.X ⟶ t.X), ∀ j, l ≫ t.π.app j = s.π.app j :=
⟨h.lift s, h.fac s, h.uniq s⟩

/-- Noncomputably make a colimit cocone from the existence of unique factorizations. -/
def of_exists_unique {t : cone F}
  (ht : ∀ s : cone F, ∃! l : s.X ⟶ t.X, ∀ j, l ≫ t.π.app j = s.π.app j) : is_limit t :=
by { choose s hs hs' using ht, exact ⟨s, hs, hs'⟩ }

/--
Alternative constructor for `is_limit`,
providing a morphism of cones rather than a morphism between the cone points
and separately the factorisation condition.
-/
@[simps]
def mk_cone_morphism {t : cone F}
  (lift : Π (s : cone F), s ⟶ t)
  (uniq' : ∀ (s : cone F) (m : s ⟶ t), m = lift s) : is_limit t :=
{ lift := λ s, (lift s).hom,
  uniq' := λ s m w,
    have cone_morphism.mk m w = lift s, by apply uniq',
    congr_arg cone_morphism.hom this }

/-- Limit cones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s ≅ t :=
{ hom := Q.lift_cone_morphism s,
  inv := P.lift_cone_morphism t,
  hom_inv_id' := P.uniq_cone_morphism,
  inv_hom_id' := Q.uniq_cone_morphism }

/-- Any cone morphism between limit cones is an isomorphism. -/
lemma hom_is_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) (f : s ⟶ t) : is_iso f :=
⟨⟨P.lift_cone_morphism t, ⟨P.uniq_cone_morphism, Q.uniq_cone_morphism⟩⟩⟩

/-- Limits of `F` are unique up to isomorphism. -/
def cone_point_unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s.X ≅ t.X :=
(cones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma cone_point_unique_up_to_iso_hom_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).hom ≫ t.π.app j = s.π.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma cone_point_unique_up_to_iso_inv_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).inv ≫ s.π.app j = t.π.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_hom {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  P.lift r ≫ (cone_point_unique_up_to_iso P Q).hom = Q.lift r :=
Q.uniq _ _ (by simp)

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_inv {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  Q.lift r ≫ (cone_point_unique_up_to_iso P Q).inv = P.lift r :=
P.uniq _ _ (by simp)

/-- Transport evidence that a cone is a limit cone across an isomorphism of cones. -/
def of_iso_limit {r t : cone F} (P : is_limit r) (i : r ≅ t) : is_limit t :=
is_limit.mk_cone_morphism
  (λ s, P.lift_cone_morphism s ≫ i.hom)
  (λ s m, by rw ←i.comp_inv_eq; apply P.uniq_cone_morphism)

@[simp] lemma of_iso_limit_lift {r t : cone F} (P : is_limit r) (i : r ≅ t) (s) :
  (P.of_iso_limit i).lift s = P.lift s ≫ i.hom.hom :=
rfl

/-- Isomorphism of cones preserves whether or not they are limiting cones. -/
def equiv_iso_limit {r t : cone F} (i : r ≅ t) : is_limit r ≃ is_limit t :=
{ to_fun := λ h, h.of_iso_limit i,
  inv_fun := λ h, h.of_iso_limit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_limit_apply {r t : cone F} (i : r ≅ t) (P : is_limit r) :
  equiv_iso_limit i P = P.of_iso_limit i := rfl

@[simp] lemma equiv_iso_limit_symm_apply {r t : cone F} (i : r ≅ t) (P : is_limit t) :
  (equiv_iso_limit i).symm P = P.of_iso_limit i.symm := rfl

/--
If the canonical morphism from a cone point to a limiting cone point is an iso, then the
first cone was limiting also.
-/
def of_point_iso {r t : cone F} (P : is_limit r) [i : is_iso (P.lift t)] : is_limit t :=
of_iso_limit P
begin
  haveI : is_iso (P.lift_cone_morphism t).hom := i,
  haveI : is_iso (P.lift_cone_morphism t) := cones.cone_iso_of_hom_iso _,
  symmetry,
  apply as_iso (P.lift_cone_morphism t),
end

variables {t : cone F}

lemma hom_lift (h : is_limit t) {W : C} (m : W ⟶ t.X) :
  m = h.lift { X := W, π := { app := λ b, m ≫ t.π.app b } } :=
h.uniq { X := W, π := { app := λ b, m ≫ t.π.app b } } m (λ b, rfl)

/-- Two morphisms into a limit are equal if their compositions with
  each cone morphism are equal. -/
lemma hom_ext (h : is_limit t) {W : C} {f f' : W ⟶ t.X}
  (w : ∀ j, f ≫ t.π.app j = f' ≫ t.π.app j) : f = f' :=
by rw [h.hom_lift f, h.hom_lift f']; congr; exact funext w

/--
Given a right adjoint functor between categories of cones,
the image of a limit cone is a limit cone.
-/
def of_right_adjoint {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ⥤ cone F) [is_right_adjoint h] {c : cone G} (t : is_limit c) :
  is_limit (h.obj c) :=
mk_cone_morphism
  (λ s, (adjunction.of_right_adjoint h).hom_equiv s c (t.lift_cone_morphism _))
  (λ s m, (adjunction.eq_hom_equiv_apply _ _ _).2 t.uniq_cone_morphism)

/--
Given two functors which have equivalent categories of cones, we can transport a limiting cone
across the equivalence.
-/
def of_cone_equiv {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} :
  is_limit (h.functor.obj c) ≃ is_limit c :=
{ to_fun := λ P, of_iso_limit (of_right_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_right_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cone_equiv_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} (P : is_limit (h.functor.obj c)) (s) :
  (of_cone_equiv h P).lift s =
    ((h.unit_iso.hom.app s).hom ≫
      (h.functor.inv.map (P.lift_cone_morphism (h.functor.obj s))).hom) ≫
      (h.unit_iso.inv.app c).hom :=
rfl

@[simp]

/--
A cone postcomposed with a natural isomorphism is a limit cone if and only if the original cone is.
-/
def postcompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone F) :
  is_limit ((cones.postcompose α.hom).obj c) ≃ is_limit c :=
of_cone_equiv (cones.postcompose_equivalence α)

/--
A cone postcomposed with the inverse of a natural isomorphism is a limit cone if and only if
the original cone is.
-/
def postcompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone G) :
  is_limit ((cones.postcompose α.inv).obj c) ≃ is_limit c :=
postcompose_hom_equiv α.symm c

/--
Constructing an equivalence `is_limit c ≃ is_limit d` from a natural isomorphism
between the underlying functors, and then an isomorphism between `c` transported along this and `d`.
-/
def equiv_of_nat_iso_of_iso {F G : J ⥤ C} (α : F ≅ G) (c : cone F) (d : cone G)
  (w : (cones.postcompose α.hom).obj c ≅ d) :
  is_limit c ≃ is_limit d :=
(postcompose_hom_equiv α _).symm.trans (equiv_iso_limit w)

/--
The cone points of two limit cones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := Q.map s w.hom,
  inv := P.map t w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy), }

@[reassoc]
lemma cone_points_iso_of_nat_iso_hom_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).hom ≫ t.π.app j = s.π.app j ≫ w.hom.app j :=
by simp

@[reassoc]
lemma cone_points_iso_of_nat_iso_inv_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).inv ≫ s.π.app j = t.π.app j ≫ w.inv.app j :=
by simp

@[reassoc]
lemma lift_comp_cone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {r s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) :
  P.lift r ≫ (cone_points_iso_of_nat_iso P Q w).hom = Q.map r w.hom :=
Q.hom_ext (by simp)

@[reassoc]
lemma lift_comp_cone_points_iso_of_nat_iso_inv {F G : J ⥤ C} {r s : cone G} {t : cone F}
  (P : is_limit t) (Q : is_limit s) (w : F ≅ G) :
  Q.lift r ≫ (cone_points_iso_of_nat_iso P Q w).inv = P.map r w.inv :=
P.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cone F` is a limit cone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cone F} (P : is_limit s) (e : K ≌ J) :
  is_limit (s.whisker e.functor) :=
of_right_adjoint (cones.whiskering_equivalence e).functor P

/--
If `s : cone F` whiskered by an equivalence `e` is a limit cone, so is `s`.
-/
def of_whisker_equivalence {s : cone F} (e : K ≌ J) (P : is_limit (s.whisker e.functor)) :
  is_limit s :=
equiv_iso_limit ((cones.whiskering_equivalence e).unit_iso.app s).symm
  (of_right_adjoint (cones.whiskering_equivalence e).inverse P : _)

/--
Given an equivalence of diagrams `e`, `s` is a limit cone iff `s.whisker e.functor` is.
-/
def whisker_equivalence_equiv {s : cone F} (e : K ≌ J) :
  is_limit s ≃ is_limit (s.whisker e.functor) :=
⟨λ h, h.whisker_equivalence e, of_whisker_equivalence e, by tidy, by tidy⟩

/--
We can prove two cone points `(s : cone F).X` and `(t.cone G).X` are isomorphic if
* both cones are limit cones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cone_points_iso_of_equivalence {F : J ⥤ C} {s : cone F} {G : K ⥤ C} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := Q.lift ((cones.equivalence_of_reindexing e.symm w').functor.obj s),
  inv := P.lift ((cones.equivalence_of_reindexing e w).functor.obj t),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cone.whisker_π, limits.cones.postcompose_obj_π, fac, whisker_left_app,
      assoc, id_comp, inv_fun_id_assoc_hom_app, fac_assoc, nat_trans.comp_app],
    rw [counit_app_functor, ←functor.comp_map, w.hom.naturality],
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a limit cone: a map `W ⟶ X` is the same as
  a cone on `F` with vertex `W`. -/
def hom_iso (h : is_limit t) (W : C) : ulift.{u₁} (W ⟶ t.X : Type v₃) ≅ (const J).obj W ⟶ F :=
{ hom := λ f, (t.extend f.down).π,
  inv := λ π, ⟨h.lift { X := W, π := π }⟩,
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_limit t) {W : C} (f : ulift.{u₁} (W ⟶ t.X)) :
  (is_limit.hom_iso h W).hom f = (t.extend f.down).π := rfl

/-- The limit of `F` represents the functor taking `W` to
  the set of cones on `F` with vertex `W`. -/
def nat_iso (h : is_limit t) : yoneda.obj t.X ⋙ ulift_functor.{u₁} ≅ F.cones :=
nat_iso.of_components (λ W, is_limit.hom_iso h (unop W)) (by tidy).

/--
Another, more explicit, formulation of the universal property of a limit cone.
See also `hom_iso`.
-/
def hom_iso' (h : is_limit t) (W : C) :
  ulift.{u₁} ((W ⟶ t.X) : Type v₃) ≅
    { p : Π j, W ⟶ F.obj j // ∀ {j j'} (f : j ⟶ j'), p j ≫ F.map f = p j' } :=
h.hom_iso W ≪≫
{ hom := λ π,
  ⟨λ j, π.app j, λ j j' f,
   by convert ←(π.naturality f).symm; apply id_comp⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [id_comp], exact (p.2 f).symm end } }

/-- If G : C → D is a faithful functor which sends t to a limit cone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cone F} {D : Type u₄} [category.{v₄} D] (G : C ⥤ D) [faithful G]
  (ht : is_limit (G.map_cone t)) (lift : Π (s : cone F), s.X ⟶ t.X)
  (h : ∀ s, G.map (lift s) = ht.lift (G.map_cone s)) : is_limit t :=
{ lift := lift,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a limit implies
`G.map_cone c` is also a limit.
-/
def map_cone_equiv {D : Type u₄} [category.{v₄} D]
  {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G) {c : cone K}
  (t : is_limit (F.map_cone c)) : is_limit (G.map_cone c) :=
begin
  apply postcompose_inv_equiv (iso_whisker_left K h : _) (G.map_cone c) _,
  apply t.of_iso_limit (postcompose_whisker_left_map_cone h.symm c).symm,
end

/--
A cone is a limit cone exactly if
there is a unique cone morphism from any other cone.
-/
def iso_unique_cone_morphism {t : cone F} :
  is_limit t ≅ Π s, unique (s ⟶ t) :=
{ hom := λ h s,
  { default := h.lift_cone_morphism s,
    uniq := λ _, h.uniq_cone_morphism },
  inv := λ h,
  { lift := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : yoneda.obj X ⋙ ulift_functor.{u₁} ≅ F.cones)

/-- If `F.cones` is represented by `X`, each morphism `f : Y ⟶ X` gives a cone with cone point
`Y`. -/
def cone_of_hom {Y : C} (f : Y ⟶ X) : cone F :=
{ X := Y, π := h.hom.app (op Y) ⟨f⟩ }

/-- If `F.cones` is represented by `X`, each cone `s` gives a morphism `s.X ⟶ X`. -/
def hom_of_cone (s : cone F) : s.X ⟶ X := (h.inv.app (op s.X) s.π).down

@[simp] lemma cone_of_hom_of_cone (s : cone F) : cone_of_hom h (hom_of_cone h s) = s :=
begin
  dsimp [cone_of_hom, hom_of_cone], cases s, congr, dsimp,
  convert congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) (op s_X)) s_π,
  exact ulift.up_down _
end

@[simp] lemma hom_of_cone_of_hom {Y : C} (f : Y ⟶ X) : hom_of_cone h (cone_of_hom h f) = f :=
congr_arg ulift.down (congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) (op Y)) ⟨f⟩ : _)

/-- If `F.cones` is represented by `X`, the cone corresponding to the identity morphism on `X`
will be a limit cone. -/
def limit_cone : cone F :=
cone_of_hom h (𝟙 X)

/-- If `F.cones` is represented by `X`, the cone corresponding to a morphism `f : Y ⟶ X` is
the limit cone extended by `f`. -/
lemma cone_of_hom_fac {Y : C} (f : Y ⟶ X) :
cone_of_hom h f = (limit_cone h).extend f :=
begin
  dsimp [cone_of_hom, limit_cone, cone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f.op) ⟨𝟙 X⟩,
  dsimp at t,
  simp only [comp_id] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cones` is represented by `X`, any cone is the extension of the limit cone by the
corresponding morphism. -/
lemma cone_fac (s : cone F) : (limit_cone h).extend (hom_of_cone h s) = s :=
begin
  rw ←cone_of_hom_of_cone h s,
  conv_lhs { simp only [hom_of_cone_of_hom] },
  apply (cone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cones` is representable, then the cone corresponding to the identity morphism on
the representing object is a limit cone.
-/
def of_nat_iso {X : C} (h : yoneda.obj X ⋙ ulift_functor.{u₁} ≅ F.cones) :
  is_limit (limit_cone h) :=
{ lift := λ s, hom_of_cone h s,
  fac' := λ s j,
  begin
    have h := cone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cone_of_hom h m,
    congr,
    rw cone_of_hom_fac,
    dsimp [cone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_limit

/--
A cocone `t` on `F` is a colimit cocone if each cocone on `F` admits a unique
cocone morphism from `t`.

See <https://stacks.math.columbia.edu/tag/002F>.
-/
@[nolint has_inhabited_instance]
structure is_colimit (t : cocone F) :=
(desc  : Π (s : cocone F), t.X ⟶ s.X)
(fac'  : ∀ (s : cocone F) (j : J), t.ι.app j ≫ desc s = s.ι.app j . obviously)
(uniq' : ∀ (s : cocone F) (m : t.X ⟶ s.X) (w : ∀ j : J, t.ι.app j ≫ m = s.ι.app j),
  m = desc s . obviously)

restate_axiom is_colimit.fac'
attribute [simp,reassoc] is_colimit.fac
restate_axiom is_colimit.uniq'

namespace is_colimit

instance subsingleton {t : cocone F} : subsingleton (is_colimit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cocone point
of a colimit cocone over `F` to the cocone point of any cocone over `G`. -/
def map {F G : J ⥤ C} {s : cocone F} (P : is_colimit s) (t : cocone G)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.desc ((cocones.precompose α).obj t)

@[simp, reassoc]
lemma ι_map {F G : J ⥤ C} {c : cocone F} (hc : is_colimit c) (d : cocone G) (α : F ⟶ G)
  (j : J) : c.ι.app j ≫ is_colimit.map hc d α = α.app j ≫ d.ι.app j :=
fac _ _ _

@[simp]
lemma desc_self {t : cocone F} (h : is_colimit t) : h.desc t = 𝟙 t.X :=
(h.uniq _ _ (λ j, comp_id _)).symm

/- Repackaging the definition in terms of cocone morphisms. -/

/-- The universal morphism from a colimit cocone to any other cocone. -/
@[simps]
def desc_cocone_morphism {t : cocone F} (h : is_colimit t) (s : cocone F) : t ⟶ s :=
{ hom := h.desc s }

lemma uniq_cocone_morphism {s t : cocone F} (h : is_colimit t) {f f' : t ⟶ s} :
  f = f' :=
have ∀ {g : t ⟶ s}, g = h.desc_cocone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/-- Restating the definition of a colimit cocone in terms of the ∃! operator. -/
lemma exists_unique {t : cocone F} (h : is_colimit t) (s : cocone F) :
  ∃! (d : t.X ⟶ s.X), ∀ j, t.ι.app j ≫ d = s.ι.app j :=
⟨h.desc s, h.fac s, h.uniq s⟩

/-- Noncomputably make a colimit cocone from the existence of unique factorizations. -/
def of_exists_unique {t : cocone F}
  (ht : ∀ s : cocone F, ∃! d : t.X ⟶ s.X, ∀ j, t.ι.app j ≫ d = s.ι.app j) : is_colimit t :=
by { choose s hs hs' using ht, exact ⟨s, hs, hs'⟩ }

/--
Alternative constructor for `is_colimit`,
providing a morphism of cocones rather than a morphism between the cocone points
and separately the factorisation condition.
-/
@[simps]
def mk_cocone_morphism {t : cocone F}
  (desc : Π (s : cocone F), t ⟶ s)
  (uniq' : ∀ (s : cocone F) (m : t ⟶ s), m = desc s) : is_colimit t :=
{ desc := λ s, (desc s).hom,
  uniq' := λ s m w,
    have cocone_morphism.mk m w = desc s, by apply uniq',
    congr_arg cocone_morphism.hom this }

/-- Colimit cocones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) : s ≅ t :=
{ hom := P.desc_cocone_morphism t,
  inv := Q.desc_cocone_morphism s,
  hom_inv_id' := P.uniq_cocone_morphism,
  inv_hom_id' := Q.uniq_cocone_morphism }

/-- Any cocone morphism between colimit cocones is an isomorphism. -/
lemma hom_is_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) (f : s ⟶ t) : is_iso f :=
⟨⟨Q.desc_cocone_morphism s, ⟨P.uniq_cocone_morphism, Q.uniq_cocone_morphism⟩⟩⟩

/-- Colimits of `F` are unique up to isomorphism. -/
def cocone_point_unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) :
  s.X ≅ t.X :=
(cocones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_hom {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : s.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).hom = t.ι.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_inv {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : t.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).inv = s.ι.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_hom_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).hom ≫ Q.desc r = P.desc r :=
P.uniq _ _ (by simp)

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_inv_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).inv ≫ P.desc r = Q.desc r :=
Q.uniq _ _ (by simp)

/-- Transport evidence that a cocone is a colimit cocone across an isomorphism of cocones. -/
def of_iso_colimit {r t : cocone F} (P : is_colimit r) (i : r ≅ t) : is_colimit t :=
is_colimit.mk_cocone_morphism
  (λ s, i.inv ≫ P.desc_cocone_morphism s)
  (λ s m, by rw i.eq_inv_comp; apply P.uniq_cocone_morphism)

@[simp] lemma of_iso_colimit_desc {r t : cocone F} (P : is_colimit r) (i : r ≅ t) (s) :
  (P.of_iso_colimit i).desc s = i.inv.hom ≫ P.desc s :=
rfl

/-- Isomorphism of cocones preserves whether or not they are colimiting cocones. -/
def equiv_iso_colimit {r t : cocone F} (i : r ≅ t) : is_colimit r ≃ is_colimit t :=
{ to_fun := λ h, h.of_iso_colimit i,
  inv_fun := λ h, h.of_iso_colimit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_colimit_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit r) :
  equiv_iso_colimit i P = P.of_iso_colimit i := rfl

@[simp] lemma equiv_iso_colimit_symm_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit t) :
  (equiv_iso_colimit i).symm P = P.of_iso_colimit i.symm := rfl

/--
If the canonical morphism to a cocone point from a colimiting cocone point is an iso, then the
first cocone was colimiting also.
-/
def of_point_iso {r t : cocone F} (P : is_colimit r) [i : is_iso (P.desc t)] : is_colimit t :=
of_iso_colimit P
begin
  haveI : is_iso (P.desc_cocone_morphism t).hom := i,
  haveI : is_iso (P.desc_cocone_morphism t) := cocones.cocone_iso_of_hom_iso _,
  apply as_iso (P.desc_cocone_morphism t),
end

variables {t : cocone F}

lemma hom_desc (h : is_colimit t) {W : C} (m : t.X ⟶ W) :
  m = h.desc { X := W, ι := { app := λ b, t.ι.app b ≫ m,
    naturality' := by intros; erw [←assoc, t.ι.naturality, comp_id, comp_id] } } :=
h.uniq { X := W, ι := { app := λ b, t.ι.app b ≫ m, naturality' := _ } } m (λ b, rfl)

/-- Two morphisms out of a colimit are equal if their compositions with
  each cocone morphism are equal. -/
lemma hom_ext (h : is_colimit t) {W : C} {f f' : t.X ⟶ W}
  (w : ∀ j, t.ι.app j ≫ f = t.ι.app j ≫ f') : f = f' :=
by rw [h.hom_desc f, h.hom_desc f']; congr; exact funext w

/--
Given a left adjoint functor between categories of cocones,
the image of a colimit cocone is a colimit cocone.
-/
def of_left_adjoint {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ⥤ cocone F) [is_left_adjoint h] {c : cocone G} (t : is_colimit c) :
  is_colimit (h.obj c) :=
mk_cocone_morphism
  (λ s, ((adjunction.of_left_adjoint h).hom_equiv c s).symm (t.desc_cocone_morphism _))
  (λ s m, (adjunction.hom_equiv_apply_eq _ _ _).1 t.uniq_cocone_morphism)

/--
Given two functors which have equivalent categories of cocones,
we can transport a colimiting cocone across the equivalence.
-/
def of_cocone_equiv {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} :
  is_colimit (h.functor.obj c) ≃ is_colimit c :=
{ to_fun := λ P, of_iso_colimit (of_left_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_left_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cocone_equiv_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit (h.functor.obj c)) (s) :
  (of_cocone_equiv h P).desc s =
    (h.unit.app c).hom ≫
    (h.inverse.map (P.desc_cocone_morphism (h.functor.obj s))).hom ≫
    (h.unit_inv.app s).hom :=
rfl

@[simp] lemma of_cocone_equiv_symm_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit c) (s) :
  ((of_cocone_equiv h).symm P).desc s =
    (h.functor.map (P.desc_cocone_morphism (h.inverse.obj s))).hom ≫ (h.counit.app s).hom :=
rfl

/--
A cocone precomposed with a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone G) :
  is_colimit ((cocones.precompose α.hom).obj c) ≃ is_colimit c :=
of_cocone_equiv (cocones.precompose_equivalence α)

/--
A cocone precomposed with the inverse of a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone F) :
  is_colimit ((cocones.precompose α.inv).obj c) ≃ is_colimit c :=
precompose_hom_equiv α.symm c

/--
Constructing an equivalence `is_colimit c ≃ is_colimit d` from a natural isomorphism
between the underlying functors, and then an isomorphism between `c` transported along this and `d`.
-/
def equiv_of_nat_iso_of_iso {F G : J ⥤ C} (α : F ≅ G) (c : cocone F) (d : cocone G)
  (w : (cocones.precompose α.inv).obj c ≅ d) :
  is_colimit c ≃ is_colimit d :=
(precompose_inv_equiv α _).symm.trans (equiv_iso_colimit w)

/--
The cocone points of two colimit cocones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cocone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := P.map t w.hom,
  inv := Q.map s w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy) }

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  s.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).hom = w.hom.app j ≫ t.ι.app j :=
by simp

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_inv {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  t.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).inv = w.inv.app j ≫ s.ι.app j :=
by simp

@[reassoc]
lemma cocone_points_iso_of_nat_iso_hom_desc {F G : J ⥤ C} {s : cocone F} {r t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) :
  (cocone_points_iso_of_nat_iso P Q w).hom ≫ Q.desc r = P.map _ w.hom :=
P.hom_ext (by simp)

@[reassoc]
lemma cocone_points_iso_of_nat_iso_inv_desc {F G : J ⥤ C} {s : cocone G} {r t : cocone F}
  (P : is_colimit t) (Q : is_colimit s) (w : F ≅ G) :
  (cocone_points_iso_of_nat_iso P Q w).inv ≫ P.desc r = Q.map _ w.inv :=
Q.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cocone F` is a colimit cocone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cocone F} (P : is_colimit s) (e : K ≌ J) :
  is_colimit (s.whisker e.functor) :=
of_left_adjoint (cocones.whiskering_equivalence e).functor P

/--
If `s : cocone F` whiskered by an equivalence `e` is a colimit cocone, so is `s`.
-/
def of_whisker_equivalence {s : cocone F} (e : K ≌ J) (P : is_colimit (s.whisker e.functor)) :
  is_colimit s :=
equiv_iso_colimit ((cocones.whiskering_equivalence e).unit_iso.app s).symm
  (of_left_adjoint (cocones.whiskering_equivalence e).inverse P : _)

/--
Given an equivalence of diagrams `e`, `s` is a colimit cocone iff `s.whisker e.functor` is.
-/
def whisker_equivalence_equiv {s : cocone F} (e : K ≌ J) :
  is_colimit s ≃ is_colimit (s.whisker e.functor) :=
⟨λ h, h.whisker_equivalence e, of_whisker_equivalence e, by tidy, by tidy⟩

/--
We can prove two cocone points `(s : cocone F).X` and `(t.cocone G).X` are isomorphic if
* both cocones are colimit cocones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cocone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cocone_points_iso_of_equivalence {F : J ⥤ C} {s : cocone F} {G : K ⥤ C} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := P.desc ((cocones.equivalence_of_reindexing e w).functor.obj t),
  inv := Q.desc ((cocones.equivalence_of_reindexing e.symm w').functor.obj s),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cocone.whisker_ι, fac, inv_fun_id_assoc_inv_app, whisker_left_app, assoc,
      comp_id, limits.cocones.precompose_obj_ι, fac_assoc, nat_trans.comp_app],
    rw [counit_inv_app_functor, ←functor.comp_map, ←w.inv.naturality_assoc],
    dsimp,
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a colimit cocone: a map `X ⟶ W` is the same as
  a cocone on `F` with vertex `W`. -/
def hom_iso (h : is_colimit t) (W : C) : ulift.{u₁} (t.X ⟶ W : Type v₃) ≅ (F ⟶ (const J).obj W) :=
{ hom := λ f, (t.extend f.down).ι,
  inv := λ ι, ⟨h.desc { X := W, ι := ι }⟩,
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_colimit t) {W : C} (f : ulift (t.X ⟶ W)) :
  (is_colimit.hom_iso h W).hom f = (t.extend f.down).ι := rfl

/-- The colimit of `F` represents the functor taking `W` to
  the set of cocones on `F` with vertex `W`. -/
def nat_iso (h : is_colimit t) : coyoneda.obj (op t.X) ⋙ ulift_functor.{u₁} ≅ F.cocones :=
nat_iso.of_components (is_colimit.hom_iso h) (by intros; ext; dsimp; rw ←assoc; refl)

/--
Another, more explicit, formulation of the universal property of a colimit cocone.
See also `hom_iso`.
-/
def hom_iso' (h : is_colimit t) (W : C) :
  ulift.{u₁} ((t.X ⟶ W) : Type v₃) ≅
    { p : Π j, F.obj j ⟶ W // ∀ {j j' : J} (f : j ⟶ j'), F.map f ≫ p j' = p j } :=
h.hom_iso W ≪≫
{ hom := λ ι,
  ⟨λ j, ι.app j, λ j j' f,
   by convert ←(ι.naturality f); apply comp_id⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [comp_id], exact (p.2 f) end } }

/-- If G : C → D is a faithful functor which sends t to a colimit cocone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cocone F} {D : Type u₄} [category.{v₄} D] (G : C ⥤ D) [faithful G]
  (ht : is_colimit (G.map_cocone t)) (desc : Π (s : cocone F), t.X ⟶ s.X)
  (h : ∀ s, G.map (desc s) = ht.desc (G.map_cocone s)) : is_colimit t :=
{ desc := desc,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cocone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a colimit implies
`G.map_cone c` is also a colimit.
-/
def map_cocone_equiv {D : Type u₄} [category.{v₄} D] {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G)
  {c : cocone K} (t : is_colimit (F.map_cocone c)) : is_colimit (G.map_cocone c) :=
begin
  apply is_colimit.of_iso_colimit _ (precompose_whisker_left_map_cocone h c),
  apply (precompose_inv_equiv (iso_whisker_left K h : _) _).symm t,
end

/--
A cocone is a colimit cocone exactly if
there is a unique cocone morphism from any other cocone.
-/
def iso_unique_cocone_morphism {t : cocone F} :
  is_colimit t ≅ Π s, unique (t ⟶ s) :=
{ hom := λ h s,
  { default := h.desc_cocone_morphism s,
    uniq := λ _, h.uniq_cocone_morphism },
  inv := λ h,
  { desc := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cocone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : coyoneda.obj (op X) ⋙ ulift_functor.{u₁} ≅ F.cocones)

/-- If `F.cocones` is corepresented by `X`, each morphism `f : X ⟶ Y` gives a cocone with cone
point `Y`. -/
def cocone_of_hom {Y : C} (f : X ⟶ Y) : cocone F :=
{ X := Y, ι := h.hom.app Y ⟨f⟩ }

/-- If `F.cocones` is corepresented by `X`, each cocone `s` gives a morphism `X ⟶ s.X`. -/
def hom_of_cocone (s : cocone F) : X ⟶ s.X := (h.inv.app s.X s.ι).down

@[simp] lemma cocone_of_hom_of_cocone (s : cocone F) : cocone_of_hom h (hom_of_cocone h s) = s :=
begin
  dsimp [cocone_of_hom, hom_of_cocone], cases s, congr, dsimp,
  convert congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) s_X) s_ι,
  exact ulift.up_down _
end

@[simp] lemma hom_of_cocone_of_hom {Y : C} (f : X ⟶ Y) : hom_of_cocone h (cocone_of_hom h f) = f :=
congr_arg ulift.down (congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) Y) ⟨f⟩ : _)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to the identity morphism on `X`
will be a colimit cocone. -/
def colimit_cocone : cocone F :=
cocone_of_hom h (𝟙 X)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to a morphism `f : Y ⟶ X` is
the colimit cocone extended by `f`. -/
lemma cocone_of_hom_fac {Y : C} (f : X ⟶ Y) :
cocone_of_hom h f = (colimit_cocone h).extend f :=
begin
  dsimp [cocone_of_hom, colimit_cocone, cocone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f) ⟨𝟙 X⟩,
  dsimp at t,
  simp only [id_comp] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cocones` is corepresented by `X`, any cocone is the extension of the colimit cocone by the
corresponding morphism. -/
lemma cocone_fac (s : cocone F) : (colimit_cocone h).extend (hom_of_cocone h s) = s :=
begin
  rw ←cocone_of_hom_of_cocone h s,
  conv_lhs { simp only [hom_of_cocone_of_hom] },
  apply (cocone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cocones` is corepresentable, then the cocone corresponding to the identity morphism on
the representing object is a colimit cocone.
-/
def of_nat_iso {X : C} (h : coyoneda.obj (op X) ⋙ ulift_functor.{u₁} ≅ F.cocones) :
  is_colimit (colimit_cocone h) :=
{ desc := λ s, hom_of_cocone h s,
  fac' := λ s j,
  begin
    have h := cocone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cocone_of_hom h m,
    congr,
    rw cocone_of_hom_fac,
    dsimp [cocone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_colimit

end category_theory.limits


import laurent_measures.basic
import laurent_measures.aux_lemmas
import analysis.special_functions.pow
import laurent_measures.thm69

open nnreal laurent_measures aux_thm69
open_locale nnreal

noncomputable theory

section slm

--  This is the same as before, from here to...
-- parameter {p : ℝ≥0}

/--  This is the same `r` as before. -/
-- def r : ℝ≥0 := 2⁻¹ ^ (p:ℝ)

-- lemma r_pos : 0 < r :=
-- suffices 0 < (2 : ℝ≥0)⁻¹ ^ (p : ℝ), by simpa [r],
-- rpow_pos (nnreal.inv_pos.mpr zero_lt_two)

-- lemma r_lt_one [fact(0 < p)] : r < 1 :=
-- begin
--   refine rpow_lt_one zero_le' (half_lt_self one_ne_zero) _,
--   rw nnreal.coe_pos,
--   exact fact.out _
-- end

variables {r : ℝ≥0} [fact (0 < r)] [fact (r < 1)]

local notation `ℒ` := laurent_measures r

variables {S : Fintype}

-- /--  Let `F : ℒ S` be a Laurent measure.  `laurent_measures.d` chooses a bound `d ∈ ℤ` for `F`,
-- such that, for all `s : S`, the sequence `F s` is zero from `d-1` and below. -/
-- def laurent_measures.d (F : ℒ S) : ℤ :=
-- (exists_bdd_filtration (fact.out _ : 0 < r) (fact.out _ : r < 1) F).some

-- lemma lt_d_eq_zero (F : ℒ S) (s : S) (n : ℤ) :
--   n < F.d → F s n = 0 :=
-- (exists_bdd_filtration (fact.out _ : 0 < r) (fact.out _ : r < 1) F).some_spec s n
--  ... here!

section new_stuff
/--  Simpler Laurent measures? -/
structure slm (r : ℝ≥0) (S : Fintype) :=
(to_fun    : S → ℤ → ℤ)
(d         : ℤ)
(summable' : ∀ s, summable (λ n : ℕ, ∥to_fun s n∥₊ * r ^ n))
(zero_lt_d : ∀ s n, n < d → to_fun s n = 0)

/--  A "usual" Laurent Measure `F : ℒ S` gives rise to a Simple Laurent Measure of type `slm S`. -/
def _root_.laurent_measures.to_slm (F : ℒ S) : slm r S :=
{ to_fun    := F.to_fun,
  d         := F.d,
  zero_lt_d := λ n s, lt_d_eq_zero F _ _,
  summable' := begin
    refine λ s, summable_coe.mp _,
    convert ((@int_summable_iff _ _ _ _ _ (λ (n : ℤ), ∥F.to_fun s n∥ * r ^ n)).mp _).1,
    { convert summable_coe.mpr (F.summable' s),
      simp }
  end }

/--  A Simple Laurent Measure `F : slm S` "usual" Laurent Measure of type `ℒ S`. -/
--  The "main" input is `int_summable_iff`, proving that a series over `ℤ` is summable if and only
--  if both its restrictions to `ℕ` and to "`-ℕ`" are summable.
def slm.to_laurent_measures {r : ℝ≥0} (F : slm r S) : laurent_measures r S :=
{ to_fun := F.to_fun,
  summable' := begin
    refine λ s, summable_coe.mp _,
    convert ((@int_summable_iff _ _ _ _ _ (λ (n : ℤ), ∥F.to_fun s n∥ * r ^ n)).mpr _),
    { simp },
    { refine ⟨_, summable_of_eventually_zero (λ (n : ℤ), ∥F.to_fun s n∥ * ↑r ^ n) F.d (λ n nd, _)⟩,
      { convert summable_coe.mpr (F.summable' s), },
      { simp [F.zero_lt_d s n nd] } }
  end }

lemma slm_lm_to_fun_eq {r : ℝ≥0} (F : slm r S) : F.to_fun = F.to_laurent_measures.to_fun := rfl

lemma lm_slm_to_fun_eq (F : ℒ S) : F.to_fun = F.to_slm.to_fun := rfl

end new_stuff

end slm


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov

! This file was ported from Lean 3 source module order.monotone.extension
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.ConditionallyCompleteLattice.Basic

/-!
# Extension of a monotone function from a set to the whole space

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

In this file we prove that if a function is monotone and is bounded on a set `s`, then it admits a
monotone extension to the whole space.
-/

open Set

variable {α β : Type _} [LinearOrder α] [ConditionallyCompleteLinearOrder β] {f : α → β} {s : Set α}
  {a b : α}

/- warning: monotone_on.exists_monotone_extension -> MonotoneOn.exists_monotone_extension is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : ConditionallyCompleteLinearOrder.{u2} β] {f : α -> β} {s : Set.{u1} α}, (MonotoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) f s) -> (BddBelow.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) (Set.image.{u1, u2} α β f s)) -> (BddAbove.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) (Set.image.{u1, u2} α β f s)) -> (Exists.{max (succ u1) (succ u2)} (α -> β) (fun (g : α -> β) => And (Monotone.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) g) (Set.EqOn.{u1, u2} α β f g s)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : ConditionallyCompleteLinearOrder.{u1} β] {f : α -> β} {s : Set.{u2} α}, (MonotoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) f s) -> (BddBelow.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) (Set.image.{u2, u1} α β f s)) -> (BddAbove.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) (Set.image.{u2, u1} α β f s)) -> (Exists.{max (succ u2) (succ u1)} (α -> β) (fun (g : α -> β) => And (Monotone.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) g) (Set.EqOn.{u2, u1} α β f g s)))
Case conversion may be inaccurate. Consider using '#align monotone_on.exists_monotone_extension MonotoneOn.exists_monotone_extensionₓ'. -/
/-- If a function is monotone and is bounded on a set `s`, then it admits a monotone extension to
the whole space. -/
theorem MonotoneOn.exists_monotone_extension (h : MonotoneOn f s) (hl : BddBelow (f '' s))
    (hu : BddAbove (f '' s)) : ∃ g : α → β, Monotone g ∧ EqOn f g s := by
  classical
    /- The extension is defined by `f x = f a` for `x ≤ a`, and `f x` is the supremum of the values
      of `f`  to the left of `x` for `x ≥ a`. -/
    rcases hl with ⟨a, ha⟩
    have hu' : ∀ x, BddAbove (f '' (Iic x ∩ s)) := fun x =>
      hu.mono (image_subset _ (inter_subset_right _ _))
    set g : α → β := fun x => if Disjoint (Iic x) s then a else Sup (f '' (Iic x ∩ s))
    have hgs : eq_on f g s := by
      intro x hx
      simp only [g]
      have : IsGreatest (Iic x ∩ s) x := ⟨⟨right_mem_Iic, hx⟩, fun y hy => hy.1⟩
      rw [if_neg this.nonempty.not_disjoint,
        ((h.mono <| inter_subset_right _ _).map_isGreatest this).csupₛ_eq]
    refine' ⟨g, fun x y hxy => _, hgs⟩
    by_cases hx : Disjoint (Iic x) s <;> by_cases hy : Disjoint (Iic y) s <;>
      simp only [g, if_pos, if_neg, not_false_iff, *]
    · rcases not_disjoint_iff_nonempty_inter.1 hy with ⟨z, hz⟩
      exact le_csupₛ_of_le (hu' _) (mem_image_of_mem _ hz) (ha <| mem_image_of_mem _ hz.2)
    · exact (hx <| hy.mono_left <| Iic_subset_Iic.2 hxy).elim
    · rw [not_disjoint_iff_nonempty_inter] at hx hy
      refine' csupₛ_le_csupₛ (hu' _) (hx.image _) (image_subset _ _)
      exact inter_subset_inter_left _ (Iic_subset_Iic.2 hxy)
#align monotone_on.exists_monotone_extension MonotoneOn.exists_monotone_extension

/- warning: antitone_on.exists_antitone_extension -> AntitoneOn.exists_antitone_extension is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : LinearOrder.{u1} α] [_inst_2 : ConditionallyCompleteLinearOrder.{u2} β] {f : α -> β} {s : Set.{u1} α}, (AntitoneOn.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) f s) -> (BddBelow.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) (Set.image.{u1, u2} α β f s)) -> (BddAbove.{u2} β (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) (Set.image.{u1, u2} α β f s)) -> (Exists.{max (succ u1) (succ u2)} (α -> β) (fun (g : α -> β) => And (Antitone.{u1, u2} α β (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (PartialOrder.toPreorder.{u2} β (SemilatticeInf.toPartialOrder.{u2} β (Lattice.toSemilatticeInf.{u2} β (ConditionallyCompleteLattice.toLattice.{u2} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u2} β _inst_2))))) g) (Set.EqOn.{u1, u2} α β f g s)))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : LinearOrder.{u2} α] [_inst_2 : ConditionallyCompleteLinearOrder.{u1} β] {f : α -> β} {s : Set.{u2} α}, (AntitoneOn.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) f s) -> (BddBelow.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) (Set.image.{u2, u1} α β f s)) -> (BddAbove.{u1} β (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) (Set.image.{u2, u1} α β f s)) -> (Exists.{max (succ u2) (succ u1)} (α -> β) (fun (g : α -> β) => And (Antitone.{u2, u1} α β (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_1))))) (PartialOrder.toPreorder.{u1} β (SemilatticeInf.toPartialOrder.{u1} β (Lattice.toSemilatticeInf.{u1} β (ConditionallyCompleteLattice.toLattice.{u1} β (ConditionallyCompleteLinearOrder.toConditionallyCompleteLattice.{u1} β _inst_2))))) g) (Set.EqOn.{u2, u1} α β f g s)))
Case conversion may be inaccurate. Consider using '#align antitone_on.exists_antitone_extension AntitoneOn.exists_antitone_extensionₓ'. -/
/-- If a function is antitone and is bounded on a set `s`, then it admits an antitone extension to
the whole space. -/
theorem AntitoneOn.exists_antitone_extension (h : AntitoneOn f s) (hl : BddBelow (f '' s))
    (hu : BddAbove (f '' s)) : ∃ g : α → β, Antitone g ∧ EqOn f g s :=
  h.dual_right.exists_monotone_extension hu hl
#align antitone_on.exists_antitone_extension AntitoneOn.exists_antitone_extension


import code
import frespects_pfun
import log_lemmas

open num (to_bits of_bits)

def time : code → ℕ →. ℕ
| code.fst := λ v, pure (nat.log 2 v + 1)
| code.snd := λ v, pure (nat.log 2 v + 1)
| (code.bit _) := λ v, pure (nat.log 2 v + 1)
| (code.pair c₁ c₂) := λ v, (+3) <$> (time c₁ v) + (time c₂ v)
| (code.comp c₁ c₂) := λ v, (+1) <$> (time c₂ v) + (c₂.eval v >>= time c₁)
| (code.case c₁ c₂ c₃) := λ v, (+1) <$> (match to_bits v with
  | [] := time c₃ 0
  | (ff :: xs) := time c₁ (of_bits xs)
  | (tt :: xs) := time c₂ (of_bits xs)
end)
| (code.fix f) := λ v₀, (+1) <$> (@pfun.fix (ℕ × ℕ) ℕ $
  λ vt, (time f vt.1) >>= λ t',
    (f.eval vt.1).map (λ v' : ℕ,
      if v'.unpair'.1 = 0 then sum.inl (vt.2+t')
      else sum.inr (v'.unpair'.2, vt.2+t'))
  ) (v₀, 0)

lemma add_def (x y : part ℕ) : x + y = x >>= λ x', y >>= (λ y', pure (x' + y')) :=
by { simp only [(+), (<*>)], simp, refl, }

private lemma time_frespects_once_eval_aux (f : code)
  (ih : ∀ (n : ℕ), (time f n).dom ↔ (f.eval n).dom) :
  pfun.frespects_once
  (λ (vt : ℕ × ℕ), (time f vt.1) >>= λ t',
    (f.eval vt.1).map (λ v' : ℕ,
      if v'.unpair'.1 = 0 then sum.inl (vt.2+t')
      else sum.inr (v'.unpair'.2, vt.2+t')))
  (λ (v : ℕ), (f.eval v).map $ λ v',
    if (nat.unpair' v').1 = 0 then sum.inl (nat.unpair' v').2 else sum.inr (nat.unpair' v').2)
  prod.fst :=
begin
  intro a, split,
  { simp [ih], }, split,
  { intro a',
    simp only [part.bind_eq_bind, part.mem_bind_iff, part.mem_map_iff, exists_prop, forall_exists_index, and_imp],
    intros n hn e he h, use e, refine ⟨he, _⟩,
    split_ifs at h, { contradiction, },
    rw ← h, split_ifs; refl,  },
  simp only [part.bind_eq_bind, part.mem_bind_iff, part.mem_map_iff, exists_prop, forall_exists_index, and_imp],
  intros n₁ n₂ hn₂ b hb h,
  refine ⟨b.unpair'.snd, b, hb, _⟩,
  split_ifs at h ⊢, { refl, }, { contradiction, },
end

lemma time_dom_iff_eval_dom (c : code) (n : ℕ) : (time c n).dom ↔ (c.eval n).dom :=
begin
  induction c generalizing n,
  iterate 3 { simp [time], refl, },
  case code.pair : c₁ c₂ c₁ih c₂ih { simp [time, add_def, c₁ih, c₂ih], },
  case code.comp : c₁ c₂ c₁ih c₂ih { simp [time, add_def, c₁ih, c₂ih], tauto, },
  case code.case : c₁ c₂ c₃ c₁ih c₂ih c₃ih { simp only [time, code.eval],
    rcases (to_bits n) with _|_|_; simp [c₁ih, c₂ih, c₃ih, time], },
  case code.fix : f ih
  { simp only [time, code.eval], refine pfun.eq_dom_of_frespects_once prod.fst _ _,
    exact time_frespects_once_eval_aux _ ih, }
end

lemma exists_mem_time_iff_exists_mem_dom (c : code) (n : ℕ) : (∃ t, t ∈ time c n) ↔ ∃ m, m ∈ c.eval n :=
by { rw [← part.dom_iff_mem, ← part.dom_iff_mem], apply time_dom_iff_eval_dom, }

lemma time_frespects_once_eval (f : code) :
  pfun.frespects_once
  (λ (vt : ℕ × ℕ), (time f vt.1) >>= λ t',
    (f.eval vt.1).map (λ v' : ℕ,
      if v'.unpair'.1 = 0 then sum.inl (vt.2+t')
      else sum.inr (v'.unpair'.2, vt.2+t')))
  (λ (v : ℕ), (f.eval v).map $ λ v',
    if (nat.unpair' v').1 = 0 then sum.inl (nat.unpair' v').2 else sum.inr (nat.unpair' v').2)
  prod.fst :=
by { apply time_frespects_once_eval_aux, simp [time_dom_iff_eval_dom], }

def time_bound (c : code) (bound : ℕ → ℕ) : Prop :=
∀ (n m : ℕ), n ≤ m → ∃ t ∈ time c n, t ≤ bound (nat.log 2 m)

def time_bound_of_monotonic_iff (c : code) {bound : ℕ → ℕ} (mono : monotone bound) :
  time_bound c bound ↔ ∀ n, ∃ t ∈ time c n, t ≤ bound (nat.log 2 n) :=
begin
  split, { intros h n, exact h n n rfl.le, },
  intros h n m hnm,
  obtain ⟨t, ht, H⟩ := h n,
  use [t, ht],
  refine H.trans _,
  apply mono, exact nat.log_le_log_of_le hnm,
end

lemma time_bound_of_time_bound_le {c : code} {b₁ : ℕ → ℕ} (hb : time_bound c b₁) (b₂ : ℕ → ℕ) (b₁_le_b₂ : ∀ n, b₁ n ≤ b₂ n) : time_bound c b₂ :=
λ n N h, let ⟨t, ht, hb⟩ := hb n N h in ⟨t, ht, hb.trans (b₁_le_b₂ _)⟩

/- Why isn't this already a lemma? -/
lemma sq_mono : monotone (λ n : ℕ, n^2) := by { intros x y hxy, nlinarith, }

lemma pair_bound {v₁ v₂ b₁ b₂ : ℕ} (hv₁ : nat.log 2 v₁ ≤ b₁^2) (hv₂ : nat.log 2 v₂ ≤ b₂^2) :
  nat.log 2 (nat.mkpair' v₁ v₂) ≤ (b₁ + b₂ + 3)^2 :=
begin
  have :=
    calc 2 * nat.log 2 (nat.log 2 v₁ + 1)
      ≤ 2 * nat.log 2 (b₁^2 + 1) : by { mono*,  { apply nat.log_monotone, mono, }, all_goals { exact zero_le _, }, }
  ... ≤ 2 * nat.log 2 ((b₁ + 1)^2) : by { mono*, { apply nat.log_monotone, ring_nf SOP, simp, }, all_goals { exact zero_le _, }, }
  ... ≤ 2 * (2 * (nat.log 2 (b₁ + 1) + 1)) : by { mono, { apply nat.log_pow_k_le, }, all_goals { exact zero_le _, }, }
  ... = 4 * nat.log 2 (b₁ + 1) + 4 : by ring
  ... ≤ 4 * b₁ + 4 : by { mono*, { exact nat.log_succ_le _ _, }, all_goals { exact zero_le _, }, },

  exact calc nat.log 2 (nat.mkpair' v₁ v₂)
      ≤ nat.log 2 v₁ + nat.log 2 v₂ + 2 * nat.log 2 (nat.log 2 v₁ + 1) + 5 : nat.mkpair'_le v₁ v₂
  ... ≤ b₁^2 + b₂^2 + (4 * b₁ + 4) + 5 : by mono*
  ... ≤ (b₁ + b₂ + 3)^2 : by { ring_nf, nlinarith, }
end

lemma eval_le_time {c : code} {n m t : ℕ} (hm : m ∈ c.eval n) (ht : t ∈ time c n) : nat.log 2 m ≤ t^2 :=
begin
  induction c generalizing n m t,
  -- TODO: these 3 cases are very similar (only the last part is different),
  -- but iterate gives some weird error, figure out why
  case code.fst : { simp only [time, part.pure_eq_some, code.eval, part.mem_some_iff] at hm ht, subst ht, subst hm,
    rw sq, exact (le_add_right (nat.log_le_log_of_le (nat.unpair'_fst_le n))).trans (nat.le_mul_self _), },
  case code.snd : { simp only [time, part.pure_eq_some, code.eval, part.mem_some_iff] at hm ht, subst ht, subst hm,
    rw sq, exact (le_add_right (nat.log_le_log_of_le (nat.unpair'_snd_le n))).trans (nat.le_mul_self _), },
  case code.bit : b { simp only [time, part.pure_eq_some, code.eval, part.mem_some_iff, pfun.coe_val] at hm ht, subst ht, subst hm,
    rw sq, refine trans _ (nat.le_mul_self _), cases n, { cases b; simp [nat.bit], }, cases b; simp [nat.bit, nat.bit0_val n.succ, nat.bit1_val n.succ], },
  case code.pair : c₁ c₂ c₁ih c₂ih
  { simp only [time, add_def, part.map_eq_map, part.pure_eq_some, part.bind_eq_bind, part.bind_some_eq_map, part.bind_map,
  part.mem_bind_iff, part.mem_map_iff, exists_prop, code.eval, part.ret_eq_some] at hm ht,
    obtain ⟨t₁, ht₁, t₂, ht₂, ht⟩ := ht, subst ht,
    obtain ⟨v₁, hv₁, v₂, hv₂, hm⟩ := hm, subst hm,
    rw [add_assoc t₁ 3 t₂, add_comm 3 t₂, ← add_assoc t₁ t₂ 3],
    exact pair_bound (c₁ih hv₁ ht₁) (c₂ih hv₂ ht₂), },
  case code.comp : c₁ c₂ c₁ih c₂ih
  { simp only [time, code.eval, exists_prop, part.pure_eq_some, part.bind_eq_bind, part.bind_map, part.map_eq_map, part.mem_bind_iff, add_def] at hm ht,
    obtain ⟨t₂, ht₂, t₁, ⟨v, hv, ht₁⟩, ht⟩ := ht,
    obtain ⟨v', hv', hm⟩ := hm, have := part.mem_unique hv hv', subst this,
    refine (c₁ih hm ht₁).trans _, apply sq_mono, simp only [part.mem_some_iff] at ht, rw ht,
    simp, },
  case code.case : c₁ c₂ c₃ c₁ih c₂ih c₃ih
  { simp only [time, part.map_eq_map, part.mem_map_iff, exists_prop, code.eval] at hm ht,
    rcases to_bits n with _|_|_; simp only [time, code.eval],
    { rintros h ⟨t₃, ht₃, ht⟩, refine (c₃ih h ht₃).trans _,  apply sq_mono, rw ← ht, simp, },
    { rintros h ⟨t₁, ht₁, ht⟩, refine (c₁ih h ht₁).trans _, apply sq_mono, rw ← ht, simp, },
    { rintros h ⟨t₂, ht₂, ht⟩, refine (c₂ih h ht₂).trans _, apply sq_mono, rw ← ht, simp, }, },
  case code.fix : f ih
  { simp only [time, part.mem_map_iff, part.map_eq_map] at ht,
    rename t t_succ, obtain ⟨t, ht, ht_succ⟩ := ht,
    obtain ⟨⟨mL, tL⟩, htime, heval⟩ := pfun.frespects_last_step (time_frespects_once_eval f) ht hm,
    simp only [part.mem_map_iff, exists_prop, part.bind_eq_bind, part.mem_bind_iff] at htime heval,
    obtain ⟨m', hm', hmm'⟩ := heval, obtain ⟨tf, htf, m'', hm'', htL⟩ := htime,
    have : m' = m'' := part.mem_unique hm' hm'', subst this, clear hm'',
    split_ifs at hmm' htL, swap, { contradiction, },
    exact calc nat.log 2 m ≤ nat.log 2 m' : by { apply nat.log_monotone, rw ← hmm', exact nat.unpair'_snd_le _, }
                      ...  ≤ tf^2 : ih hm' htf
                      ...  ≤ t_succ^2 : by { rw [← ht_succ, ← htL], mono, apply le_add_right, simp, }, },
end

lemma one_le_time {c : code} {n t : ℕ} (ht : t ∈ time c n) : 1 ≤ t :=
begin
  cases c,
  iterate 3 { simp [time] at ht, simp [ht], },
  all_goals { simp only [time, add_def, part.map_eq_map, part.pure_eq_some, part.bind_eq_bind, part.bind_some_eq_map, part.bind_map,
      part.mem_bind_iff, part.mem_map_iff, exists_prop] at ht, },
  { obtain ⟨_, _, _, _, ht⟩ := ht, rw ← ht, nlinarith only, },
  { obtain ⟨_, _, _, _, ht⟩ := ht, rw ← ht, nlinarith only, },
  { obtain ⟨_, _, ht⟩ := ht, rw ← ht, nlinarith only, },
  { obtain ⟨_, _, ht⟩ := ht, rw ← ht, nlinarith only, },
end

lemma time_bound_fst : time_bound code.fst (λ t, t+1) :=
by { rw time_bound_of_monotonic_iff, { simp [time], }, { intros x y h, simpa }, }

lemma time_bound_snd : time_bound code.snd (λ t, t+1) :=
by { rw time_bound_of_monotonic_iff, { simp [time], }, { intros x y h, simpa }, }

lemma time_bound_bit (b : bool) : time_bound (code.bit b) (λ t, t+1) :=
by { rw time_bound_of_monotonic_iff, { simp [time], }, { intros x y h, simpa }, }

lemma time_bound_pair {c₁ c₂ : code} {b₁ b₂ : ℕ → ℕ} (hb₁ : time_bound c₁ b₁) (hb₂ : time_bound c₂ b₂) :
  time_bound (code.pair c₁ c₂) (λ t, (b₁ t) + (b₂ t) + 3) :=
begin
  intros n N h,
  obtain ⟨t₁, ht₁, hb₁⟩ := hb₁ n N h, obtain ⟨t₂, ht₂, hb₂⟩ := hb₂ n N h,
  use (t₁ + t₂ + 3), split,
  { rw ← part.eq_some_iff at ht₁ ht₂, simp [time, ht₁, ht₂, add_def], ring, },
  { mono*, },
end

lemma time_bound_comp {c₁ c₂ : code} {b₁ b₂ : ℕ → ℕ} (hb₁ : time_bound c₁ b₁) (hb₂ : time_bound c₂ b₂) :
  time_bound (code.comp c₁ c₂) (λ t, (b₂ t) + (b₁ ((b₂ t)^2 + 1)) + 1) :=
begin
  intros n N h,
  obtain ⟨t₂, ht₂, hb₂⟩ := hb₂ n N h,
  obtain ⟨m, hm⟩ := (exists_mem_time_iff_exists_mem_dom c₂ n).mp ⟨_, ht₂⟩,
  obtain ⟨t₁, ht₁, hb₁⟩ := hb₁ m (2^((b₂ $ nat.log 2 N)^2 + 1)) _,
  { use t₁ + t₂ + 1, split,
    { rw ← part.eq_some_iff at ht₁ ht₂ hm, simp [time, ht₁, ht₂, add_def, hm], ring, },
    rw add_comm t₁ t₂, mono*, rwa nat.log_pow (show 1 < 2, by norm_num) at hb₁, },
  apply le_of_lt, apply nat.lt_pow_succ_of_log_le, { norm_num },
  exact calc nat.log 2 m ≤ t₂^2 : eval_le_time hm ht₂
                     ... ≤ (b₂ $ nat.log 2 N)^2 : by mono,
end

lemma time_bound_case {c₁ c₂ c₃ : code} {b₁ b₂ b₃ : ℕ → ℕ} (hb₁ : time_bound c₁ b₁) (hb₂ : time_bound c₂ b₂) (hb₃ : time_bound c₃ b₃) :
  time_bound (code.case c₁ c₂ c₃) (λ t, (max (max (b₁ t) (b₂ t)) (b₃ 0)) + 1) :=
begin
  intros n N h,
  rcases e : (to_bits n) with _ |_|_,
  { obtain ⟨t, ht, hb⟩ := hb₃ 0 0 rfl.le, use (t+1),
    split, { simpa [time, e], }, norm_num at hb, mono, simp only [le_max_iff], right, assumption, },
  { obtain ⟨t, ht, hb⟩ := hb₁ (of_bits this_tl) N _, use t+1, split,
    { simpa [time, e], }, { mono, simp only [le_max_iff], left, left, assumption, },
    transitivity (of_bits (to_bits n) : ℕ),
    { apply le_of_lt, apply num.of_bits_strict_mono, rw e, simp, },
    simpa, },
  { obtain ⟨t, ht, hb⟩ := hb₂ (of_bits this_tl) N _, use t+1, split,
    { simpa [time, e], }, { mono, simp only [le_max_iff], left, right, assumption, },
    transitivity (of_bits (to_bits n) : ℕ),
    { apply le_of_lt, apply num.of_bits_strict_mono, rw e, simp, },
    simpa, },
end

lemma time_bound_case' {c₁ c₂ c₃ : code} {b₁ b₂ b₃ : ℕ → ℕ} (hb₁ : time_bound c₁ b₁) (hb₂ : time_bound c₂ b₂) (hb₃ : time_bound c₃ b₃) :
  time_bound (code.case c₁ c₂ c₃) (λ t, (b₁ t) + (b₂ t) + (b₃ 0) + 1) :=
begin
  apply time_bound_of_time_bound_le (time_bound_case hb₁ hb₂ hb₃),
  intro n, simp, split; nlinarith only,
end


-- import for_mathlib.short_exact_sequence
import data.int.interval
import data.finset.nat_antidiagonal
import laurent_measures.aux_lemmas
import laurent_measures.basic
import laurent_measures.theta
import linear_algebra.basic
import order.filter.at_top_bot tactic.linarith
import for_mathlib.nnreal

/-!
This file introduces the maps
* `θ`, which is the specialization of evaluation-at-ξ map `ϑ` from `laurent_measures.theta`
  at `ξ=2⁻¹`.
* `ϕ` which corresponds to multiplying a Laurent series in `ℒ S = (laurent_measures r S)`
  for `r = 2^(1/p)` by `T⁻¹-2`.
* `ψ` corresponds to dividing a Laurent series by `(T⁻¹-2)`. It is defined only on series
  vanishing at `2⁻¹`, so that it again takes values in `ℒ S`
* The maps `Θ`, `Φ` and `Ψ` are the "measurifications" of `θ`, `ϕ` and `ψ`,
  so they are morphisms in the right category (**[FAE]** Not here any more!)

The main results are
* `injective_ϕ` stating that `ϕ` is injective;
* `θ_ϕ_complex` stating that `ϕ ∘ θ = 0`; and
* `θ_ϕ_exact` stating that the kernel of `θ` coincides with the image of `ϕ`.
Together with `ϑ_surjective` from `laurent_measures.theta` (specialized at `ξ=2⁻¹`, so that `ϑ` is
`θ`) this is the statement of Theorem 6.9 of `Analytic.pdf` of interest to us, although only "on
elements" and not yet as a Short Exact Sequence in the right category.
-/

noncomputable theory

open nnreal theta laurent_measures aux_thm69 finset
open_locale nnreal classical big_operators topological_space

section phi

parameter {r : ℝ≥0}

local notation `ℒ` := laurent_measures r
variables [fact (0 < r)]
variable {S : Fintype}

def ϕ : ℒ S → ℒ S :=
λ F, shift (1) F - 2 • F

lemma ϕ_apply (F : ℒ S) (s : S) (n : ℤ) : ϕ F s n = F s (n+1) - 2 * F s n :=
by simp only [ϕ, sub_apply, nsmul_apply, shift_to_fun_to_fun, nsmul_eq_mul]; refl

lemma ϕ_natural (S T : Fintype) (f : S ⟶ T) : --[fact (0 < p)] [fact ( p ≤ 1)] :
  ϕ ∘ laurent_measures.map_hom f = laurent_measures.map_hom f ∘ ϕ :=
begin
  ext F t n,
  simp only [ϕ, sum_sub_distrib, mul_sum, function.comp_app, map_hom_to_fun, sub_apply,
    nsmul_apply, shift_to_fun_to_fun,
    map_apply, nsmul_eq_mul, mul_ite, mul_zero], -- squeezed for time
end

-- #check @ϕ

-- lemma tsum_reindex (F : ℒ S) (N : ℤ) (s : S) : ∑' (l : ℕ), (F s (N + l) : ℝ) * (2 ^ l)⁻¹ =
--  2 ^ N * ∑' (m : {m : ℤ // N ≤ m}), (F s m : ℝ) * (2 ^ m.1)⁻¹ :=
-- begin
--   have h_shift := int_tsum_shift (λ n, (F s n : ℝ) * (2 ^ (-n))) N,
--   simp only at h_shift,
--   simp_rw [subtype.val_eq_coe, ← zpow_neg],
--   rw [← h_shift, ← _root_.tsum_mul_left, tsum_congr],
--   intro n,
--   rw [mul_comm (_ ^ N), mul_assoc, ← (zpow_add₀ (@two_ne_zero ℝ _ _)), neg_add_rev,
--     neg_add_cancel_comm, zpow_neg, zpow_coe_nat, add_comm],
-- end

variable [fact (r < 1)]

lemma injective_ϕ (F : ℒ S) (H : ϕ F = 0) : F = 0 :=
begin
  dsimp only [ϕ] at H, rw [sub_eq_zero] at H,
  replace H : ∀ n : ℤ, ∀ s : S, 2 * F s (n - 1) = F s n,
  { intros n s,
    rw laurent_measures.ext_iff at H,
    convert (H s (n-1)).symm using 1,
    { rw [two_smul, two_mul], refl, },
    { simp [shift] } },
  ext s n,
  apply int.induction_on' n (F.d - 1),
  { refine lt_d_eq_zero _ _ (F.d - 1) _,
    simp only [sub_lt_self_iff, zero_lt_one], },
  { intros k h hk₀,
    simp [← H (k + 1) s, add_sub_cancel, hk₀, mul_zero] },
  { intros k h hk₀,
    simpa only [hk₀, mul_eq_zero, bit0_eq_zero, one_ne_zero, false_or, zero_apply] using H k s }
end

lemma injective_ϕ' : function.injective (ϕ : ℒ S → ℒ S) :=
begin
  let PHI : comphaus_filtered_pseudo_normed_group_hom (ℒ S) (ℒ S) :=
    shift (1) - 2 • comphaus_filtered_pseudo_normed_group_hom.id,
  apply (injective_iff_map_eq_zero (PHI.to_add_monoid_hom)).mpr,
  exact injective_ϕ
end

end phi

section mem_exact

parameter {p : ℝ≥0}

/-- `r`, or `r(p)`, is `2⁻ᵖ`. -/
def r : ℝ≥0 := 2⁻¹ ^ (p : ℝ)

lemma r_pos : 0 < r :=
suffices 0 < (2 : ℝ≥0)⁻¹ ^ (p : ℝ), by simpa [r],
rpow_pos (nnreal.inv_pos.mpr zero_lt_two)

instance r_pos' : fact (0 < r) := ⟨r_pos⟩

lemma r_coe : (2⁻¹ : ℝ) ^ (p : ℝ) = r :=
begin
  have : (2⁻¹ : ℝ) = ((2⁻¹ : ℝ≥0) : ℝ),
  simp only [one_div, nonneg.coe_inv, nnreal.coe_bit0, nonneg.coe_one],
  rw [this, ← nnreal.coe_rpow, nnreal.coe_eq],
  refl,
end

variable [fact(0 < p)]

lemma r_lt_one : r < 1 :=
begin
  refine rpow_lt_one two_inv_lt_one _,
  rw nnreal.coe_pos,
  exact fact.out _
end

instance r_lt_one' : fact (r < 1) := ⟨r_lt_one⟩

variable {S : Fintype}

local notation `ℒ` := laurent_measures r
local notation `ℳ` := real_measures p

theorem nnreal.rpow_int_cast (x : nnreal) (n : ℤ) : x ^ (n : ℝ) = x ^ n :=
begin
  apply subtype.ext,
  simp,
end

def θ : ℒ S → ℳ S := ϑ 2⁻¹ r p S

lemma θ_natural [fact (0 < p)] [fact (p ≤ 1)] (S T : Fintype) (f : S ⟶ T) (F : ℒ S) (t : T) :
  θ (map f F) t = real_measures.map f (θ F) t :=
begin
  simp only [θ, ϑ, one_div, map_apply, int.cast_sum, inv_zpow', zpow_neg, real_measures.map_apply],
  rw ← tsum_sum,
  { congr', ext n, exact sum_mul, },
  intros,
  rw mem_filter at H,
  rcases H with ⟨-, rfl⟩,
  have := F.summable i,
  refine summable.add_compl (_ : summable (_ ∘ (coe : {n : ℤ | 0 ≤ n} → ℤ))) _,
  { have moo := summable.comp_injective this
      (subtype.coe_injective : function.injective (coe : {n : ℤ | 0 ≤ n} → ℤ)),
    refine summable_of_norm_bounded _ (moo) _, clear moo this,
    rintro ⟨n, (hn : 0 ≤ n)⟩,
    simp only [function.comp_app, subtype.coe_mk, norm_mul, norm_inv, norm_zpow, real.norm_two],
    rw (F i n).norm_cast_real,
    apply mul_le_mul_of_nonneg_left _ (norm_nonneg _),
    delta r,
    delta r,
    rw (by push_cast : ((2 : ℝ) ^ n)⁻¹ = ((2 ^ n)⁻¹ : nnreal)),
    norm_cast,
    rw [← nnreal.rpow_int_cast, ← inv_rpow],
    rw nnreal.rpow_int_cast,
    set m := n.nat_abs with hm,
    have hmn : n = m := by { rw hm, exact int.eq_nat_abs_of_zero_le hn },
    rw hmn,
    norm_cast,
    apply pow_le_pow_of_le, clear hn hmn hm m n,
    apply nnreal.le_self_rpow' (two_inv_lt_one.le),
    norm_cast,
    exact fact.out _,
  },
  {
    obtain ⟨d, hd⟩ := exists_bdd_filtration (r_pos) (r_lt_one) F,
    apply summable_of_ne_finset_zero, -- missing finset
    swap, exact (finset.subtype _ (finset.Ico d 0)),
    rintros ⟨z, (hz : ¬ (0 ≤ z))⟩ hz2,
    simp only [subtype.coe_mk, mul_eq_zero, int.cast_eq_zero, inv_eq_zero],
    left,
    apply hd,
    simp only [mem_subtype, subtype.coe_mk, mem_Ico, not_and, not_le] at hz2,
    by_contra h,
    push_neg at h,
    apply hz,
    specialize hz2 h,
    push_neg at hz2,
    exact hz2 },
end

variables [fact (p < 1)]

lemma half_lt_r : 2⁻¹ < r :=
calc (2⁻¹:ℝ≥0)
    = 2⁻¹ ^ (1:ℝ) : (rpow_one (2⁻¹:ℝ≥0)).symm
... < r : rpow_lt_rpow_of_exponent_gt (begin rw nnreal.inv_pos, norm_num, end)
  (begin apply nnreal.inv_lt_one, norm_num end) $
(nnreal.coe_lt_coe.mpr (fact.out _)).trans_le (nnreal.coe_one).le

lemma one_lt_two_r : 1 < 2 * r :=
begin
  have := half_lt_r,
  have this2 : (2⁻¹ : ℝ) < r,
    assumption_mod_cast,
  rw inv_pos_lt_iff_one_lt_mul' at this2, assumption_mod_cast,
  norm_num,
end

lemma r_inv_lt_2 : r⁻¹ < 2 :=
begin
  rw ← inv_inv (2 : ℝ≥0),
  exact nnreal.inv_lt_inv (by norm_num) half_lt_r,
end

lemma laurent_measures.summable_half (F : ℒ S) (s : S) :
  summable (λ n, ((F s n) : ℝ) * 2⁻¹ ^ n) :=
aux_thm69.summable_smaller_radius F.d (F.summable s) (λ n hn, lt_d_eq_zero _ _ _ hn) half_lt_r

lemma θ_ϕ_complex (F : ℒ S) : (θ ∘ ϕ) F = 0 :=
begin
  have t0 : (2 : ℝ)⁻¹ ≠ 0 := inv_ne_zero two_ne_zero,
  funext s,
  convert_to ∑' (n : ℤ), ((F s (n + 1) - 2 * F s n) : ℝ) * 2⁻¹ ^ n = 0,
  { apply tsum_congr,
    intro b,
    field_simp [ϕ] },
  simp_rw [sub_mul],
  rw [tsum_sub, sub_eq_zero],
  -- old proof was slicker :-(
  { refine tsum_eq_tsum_of_ne_zero_bij (λ i, (i.val : ℤ) - 1) _ _ _,
    { rintros ⟨x, _⟩ ⟨y, _⟩ h, dsimp at *, linarith },
    { rintros x hx,
      refine ⟨⟨x + 1, _⟩, _⟩,
      { rw function.mem_support at ⊢ hx,
        convert hx using 1,
        simp [zpow_add₀],
        ring },
      { simp } },
    { rintro ⟨i, hi⟩,
      simp [zpow_sub₀],
      ring } },
  { rw ← (equiv.add_group_add (-1 : ℤ)).summable_iff,
    simp only [function.comp, one_div, inv_zpow', equiv.add_group_add_apply,
      neg_add_cancel_comm],
    convert summable.mul_right 2 (F.summable_half s),
    ext x,
    simp [zpow_add₀], ring },
  { simp_rw [mul_assoc],
    convert (F.summable_half s).mul_left 2 },
end
.

/-!

### Definition of ψ

This involves dividing by T⁻¹ - 2 and we have to check that this process converges.
The proof below is pretty icky. It's "do some trivial rearrangements and it boils
down to the fact that you can interchange the order of summation in a ℝ≥0-valued
sum of sums"

-/

lemma nnreal.summable_mul_left_iff {X : Type*} {f : X → ℝ≥0} {a : ℝ≥0} (ha : a ≠ 0) :
summable f ↔ summable (λ (x : X), a * f x) :=
begin
  rw [← nnreal.summable_coe, ← nnreal.summable_coe],
  rw summable_mul_left_iff (by exact_mod_cast ha : (a : ℝ) ≠ 0),
  apply summable_congr,
  intro b,
  norm_cast,
end

lemma psi_def_summable {S : Fintype} (n : ℕ)
  (F : ℒ S)
  (s : S) :
  summable
    (λ (k : ℕ),
       r ^ (F.d + ↑n) *
         (2⁻¹ ^ (k : ℤ) * ∥F s (F.d + ↑n + ↑k)∥₊)) :=
begin
  have := F.summable_half s,
  apply summable.mul_left,
  have h : (2⁻¹ : ℝ≥0) ≠ 0 := by norm_num,
  rw nnreal.summable_mul_left_iff (show ((2⁻¹ : ℝ≥0) ^ (F.d + n) ≠ 0), from zpow_ne_zero _ h),
  simp only [← mul_assoc, ← zpow_add₀ h],
  have this2 := lt_d_eq_zero F s,
  rw ← summable_norm_iff at this,
  simp_rw ← _root_.coe_nnnorm at this,
  rw summable_coe at this,
  rw nnreal.summable_iff_on_nat_less_shift F.d _ (F.d + n) at this,
  { convert this,
    ext1 k,
    rw mul_comm,
    simp only [inv_zpow', neg_add_rev, nnnorm_mul, nnnorm_zpow, real.nnnorm_two],
    congr' },
  { intros n hn,
    simp [this2 n hn] },
end

lemma psi_def_summable2 {S : Fintype}
  [fact (0 < p)]
  [fact (p < 1)]
  (F : ℒ S)
  (s : ↥S) :
  ∀ (k : ℕ),
    summable
      (λ (n : ℕ),
         r ^ (F.d + ↑n) *
           ((2⁻¹ : ℝ≥0) ^ (k : ℤ) * ∥F s (F.d + ↑n + ↑k)∥₊)) :=
begin
  intro k,
  have hhalf : (2⁻¹ : ℝ≥0) ≠ 0, by norm_num,
  have hhalf' : (2⁻¹ : ℝ≥0) ≠ 0, by norm_num,
  have hr : r ≠ 0 := r_pos.ne.symm,
  rw nnreal.summable_mul_left_iff
    (show (2⁻¹ : ℝ≥0) ^ (-(k : ℤ)) * r ^ (k : ℤ) ≠ 0, from mul_ne_zero (zpow_ne_zero _ hhalf') (zpow_ne_zero _ hr)),
  have : ∀ x : ℕ, 2⁻¹ ^ -(k : ℤ) * r ^ (k : ℤ) * (r ^ (F.d + ↑x) * (2⁻¹ ^ (k : ℤ) * ∥F s (F.d + ↑x + ↑k)∥₊))
    = r ^ (F.d + x + k) * ∥F s (F.d + ↑x + ↑k)∥₊,
  { intro x,
    rw (show (2⁻¹ : ℝ≥0) ^ -(k : ℤ) * r ^ (k : ℤ) * (r ^ (F.d + ↑x) * (2⁻¹ ^ (k : ℤ) * ∥F s (F.d + ↑x + ↑k)∥₊))
      = (2⁻¹ : ℝ≥0) ^ -(k : ℤ) * 2⁻¹ ^ (k : ℤ) * r ^ (k : ℤ) * r ^ (F.d + ↑x) *  ∥F s (F.d + ↑x + ↑k)∥₊, by ring),
    simp only [zpow_add₀ hr, ← zpow_add₀ hhalf'],
    simp,
    left,
    ring,
    },
  rw summable_congr this, clear this,
  have := F.summable' s,
  rw nnreal.summable_iff_on_nat_less_shift F.d _ (F.d + k) at this,
  { convert this,
    ext n,
    rw [mul_comm, add_right_comm],
    refl },
  { intros n hn,
    convert zero_mul _,
    convert nnnorm_zero,
    exact lt_d_eq_zero F s n hn },
end

lemma psi_def_summable3 {S : Fintype}
  [fact (0 < p)]
  [fact (p < 1)]
  (F : ℒ S)
  (s : ↥S) :
  summable
    (λ (k : ℕ),
       ∑' (n : ℕ),
         r ^ (F.d + ↑n) *
           (2⁻¹ ^ (k : ℤ) * ∥F s (F.d + ↑n + ↑k)∥₊)) :=
begin
  -- take 2⁻¹^k out the tsum,
  -- put r^k into the tsum,
  -- bounded by sum of GP,
  have bdd : ∀ k : ℕ, ∑' (n : ℕ),
         r ^ (F.d + ↑n + k) * ∥F s (F.d + ↑n + ↑k)∥₊ ≤
           ∑' (t : ℤ),
         r ^ t * ∥F s t∥₊,
  { intro k,
    simp_rw add_right_comm,
    have hinj : function.injective (λ (m : ℕ), F.d + k + m),
    { rintros a b (h2 : F.d + k + a = F.d + k + b),
      simpa using h2 },
      refine tsum_le_tsum_of_inj _ hinj _ _ _ _,
      { intros, apply zero_le' },
      { intro, refl },
      { rw ← @nnreal.summable_iff_on_nat_less_shift (λ (z : ℤ), r ^ z * ∥F s z∥₊) F.d _ (F.d + k),
        { convert F.summable' s,
          ext z,
          rw mul_comm,
          refl },
        { intros n hn,
          simp [lt_d_eq_zero F s n hn] } },
      { convert F.summable' s,
        ext z,
        rw mul_comm,
        refl } },
  have : ∀ k : ℕ, ∑' (n : ℕ), r ^ (F.d + ↑n) * (2⁻¹ ^ (k : ℤ) * ∥F s (F.d + ↑n + ↑k)∥₊) =
   (∑' (n : ℕ), r ^ (F.d + ↑n + k) * (∥F s (F.d + ↑n + ↑k)∥₊)) * (2⁻¹ * r⁻¹) ^ (k : ℤ),
  { intro k,
    rw ← nnreal.tsum_mul_right,
    apply tsum_congr,
    intro n,
    simp only [zpow_add₀ r_pos.ne.symm, zpow_coe_nat, one_div, inv_pow, div_zpow],
    have foo : (2 * r) ^ k ≠ 0,
    { apply pow_ne_zero, apply mul_ne_zero,
      { norm_num },
      { exact r_pos.ne.symm },

    },
    field_simp [foo],
    rw mul_pow,
    ring, },
  rw summable_congr this, clear this,
  suffices : summable (λ k : ℕ, (∑' (t : ℤ), r ^ t * ∥F s t∥₊) * (2⁻¹ * r⁻¹) ^ k),
  { refine summable_of_le _ this,
    intro k,
    rw zpow_coe_nat,
    apply nnreal.mul_le_mul_right (bdd k),
  },
  apply summable.mul_left,
  apply summable_geometric,
  exact div_lt_one_of_lt half_lt_r,
end

lemma psi_def_aux_4 {S : Fintype} [fact (0 < p)] [fact (p < 1)] (F : ℒ S) (s : ↥S) : summable
  (λ (m : ℕ),
     ∥(2 : ℝ) ^ (F.d + ↑m)∥₊ *
       ((∑' (k : ℕ), ∥F s (F.d + ↑m + ↑k)∥₊ * 2⁻¹ ^ (F.d + ↑m + ↑k)) * r ^ (F.d + ↑m))) :=
begin
  -- tidy up
  simp_rw [nnnorm_zpow, real.nnnorm_two],
  have : ∀ m : ℕ, (2 : ℝ≥0) ^ (F.d + ↑m) *
  ((∑' (k : ℕ), ∥F s (F.d + ↑m + ↑k)∥₊ * 2⁻¹ ^ (F.d + ↑m + ↑k)) * r ^ (F.d + ↑m)) =
  ∑' (k : ℕ), (2 : ℝ≥0) ^ (F.d + ↑m) * ∥F s (F.d + ↑m + ↑k)∥₊ * 2⁻¹ ^ (F.d + ↑m + ↑k) * r ^ (F.d + ↑m),
  { intro m,
    rw [← nnreal.tsum_mul_right, ← nnreal.tsum_mul_left],
    apply tsum_congr,
    intro b,
    ring },
  rw summable_congr this, clear this,
  -- TODO : maybe now is the time to tidy up a bit (e.g. cancel the 2^x and 2⁻¹^x)
  suffices : summable
  (λ (m : ℕ), ∑' (k : ℕ),
       ∥F s (F.d + ↑m + ↑k)∥₊ *
       2⁻¹ ^ (k : ℤ) * r ^ (F.d + ↑m)),
  { refine (summable_congr _).2 this,
    intro m,
    apply tsum_congr,
    intro b,
    rw [inv_zpow , inv_zpow],
    rw [← zpow_neg, ←zpow_neg],
    have h2 : (2 : ℝ≥0) ≠ 0 := two_ne_zero,
    simp only [zpow_add₀, ne.def, bit0_eq_zero, one_ne_zero, not_false_iff, zpow_coe_nat, neg_add_rev, zpow_neg,
  mul_eq_mul_right_iff],
    field_simp [zpow_ne_zero _ h2], left,
    ring,
  },
  simp_rw [mul_comm],
  -- change order of summation
  apply nnreal.summable_symm,
  -- check various things are summable
  have := F.summable_half s,
  { intro n,
    apply psi_def_summable },
  { apply psi_def_summable2 },
  -- sum is then bounded above by a GP.
  { apply psi_def_summable3, },
end

lemma psi_def_aux_3 {S : Fintype} [fact (0 < p)] [fact (p < 1)] (F : ℒ S) (s : ↥S) : summable
  (λ (n : ℤ),
     ∥-(2 : ℝ) ^ (n - 1)∥₊ *
       ite (F.d ≤ n) ((∑' (k : ℕ), ∥F s (n + ↑k)∥₊ * 2⁻¹ ^ (n + ↑k)) * r ^ n) 0) :=
begin
  -- get rid of factor of -2⁻¹
  simp_rw [_root_.nnnorm_neg, zpow_sub₀ (two_ne_zero : (2 : ℝ) ≠ 0), nnnorm_div, zpow_one,
    div_eq_mul_inv _ ∥(2 : ℝ)∥₊, mul_comm _ ∥(2 : ℝ)∥₊⁻¹, mul_assoc],
  apply summable.mul_left,
  have hinj : function.injective (λ (m : ℕ), F.d + m),
  { rintros a b (h2 : F.d + a = F.d + b),
    simpa using h2 },
  -- change outer sum to m : ℕ with n : ℤ = F.d + m
  suffices : summable (λ (m : ℕ),
     ∥(2 : ℝ) ^ (F.d + m)∥₊ *
       ((∑' (k : ℕ), ∥F s (F.d + m + ↑k)∥₊ * 2⁻¹ ^ (F.d + m + ↑k)) * r ^ (F.d + m))),
  refine nnreal.summable_of_comp_injective hinj _ _,
  { intros a ha,
    rw [if_neg], simp,
    intro hda, apply ha,
    use (a - F.d).to_nat,
    simp, rw int.to_nat_of_nonneg, ring, linarith },
  { refine (summable_congr _).1 this,
    simp },
  exact psi_def_aux_4 F s,
end

lemma psi_def_aux_2 {S : Fintype} [fact (0 < p)] [fact (p < 1)] (F : ℒ S) (s : ↥S) : summable
  (λ (n : ℤ),
     ite (F.d ≤ n) ∥-(2 : ℝ) ^ (n - 1) * ∑' (k : ℕ), ↑(F s (n + ↑k)) * 2⁻¹ ^ (n + ↑k) * r ^ n∥₊ 0) :=
begin
  simp_rw [nnnorm_mul],
  -- next : put norm inside inner tsum (a one way implication)
  suffices : summable
  (λ (n : ℤ), ∥-(2 : ℝ) ^ (n - 1)∥₊ *
     ite (F.d ≤ n)
     ((∑' (k : ℕ), ∥F s (n + ↑k)∥₊ * 2⁻¹ ^ (n + ↑k)) * r ^ n)
       0),
  refine summable_of_le _ this,
  { intro n,
    split_ifs,
    { simp only [_root_.nnnorm_neg, nnnorm_zpow, real.nnnorm_two, one_div, inv_zpow', neg_add_rev],
      refine mul_le_mul_of_nonneg_left _ _,
      { refine le_trans (nnnorm_tsum_le _) _,
        { clear this, have := F.summable_half s,
          simp_rw nnnorm_mul,
          apply summable.mul_right,
          rw ← summable_norm_iff at this,
          simp_rw ← _root_.coe_nnnorm at this,
          rw nnreal.summable_coe at this,
          have hinj : function.injective (λ (b : ℕ), n + b),
          { rintros a b (h2 : n + a = n + b),
            simpa using h2 },
            convert summable_comp_injective this hinj,
            ext1 k,
            simp [← zpow_neg] },
        { rw ← nnreal.tsum_mul_right,
          apply le_of_eq,
          apply tsum_congr,
          { intro k,
            simp only [nnnorm_mul, nnnorm_zpow, real.nnnorm_two, nnnorm_eq, mul_eq_mul_right_iff],
            left, left,
            congr } } },
      { simp } },
    { simp } },
  exact psi_def_aux_3 _ _,
end

lemma psi_def_aux {S : Fintype} [fact (0 < p)] [fact (p < 1)] (F : ℒ S) (s : ↥S) :
  summable (λ (n : ℤ), ∥ite (F.d ≤ n) (-(2 : ℝ) ^ (n - 1) *
    ∑' (k : ℕ), ↑(F s (n + ↑k)) * 2⁻¹ ^ (n + ↑k)) 0∥₊ * r ^ n) :=
begin
  suffices :  summable (λ (n : ℤ), ite (F.d ≤ n) ∥-(2 : ℝ) ^ (n - 1) *
    ∑' (k : ℕ), ↑(F s (n + ↑k)) * 2⁻¹ ^ (n + ↑k) * r ^ n∥₊ 0),
  refine summable_of_le _ this,
  { intro n,
    split_ifs,
    { apply le_of_eq,
      simp_rw _root_.tsum_mul_right,
      rw [ ← mul_assoc, nnnorm_mul _ ((r : ℝ) ^ n)],
      simp },
    { simp } },
  exact psi_def_aux_2 _ _,
end

def ψ (F : ℒ S) (hF : θ F = 0) : ℒ S :=
{ to_fun := λ s n, if F.d ≤ n then
    ∑ l in range (n - F.d).nat_abs.succ, F s (n - 1 - l) * (2 ^ l)
    else 0,
  summable' := λ s, begin
    -- make everything real
    change summable (λ (n : ℤ),
     ∥((ite (F.d ≤ n)
       (∑ (l : ℕ) in range (n - F.d).nat_abs.succ, F s (n - 1 - ↑l) * 2 ^ l) 0 : ℤ) : ℝ)∥₊
     * r ^ n),
    push_cast,
    -- hypothesis that infinite sum converges at r>2⁻¹
    -- get hypothesis that infinite sum is 0 at 2⁻¹
    simp only [θ, ϑ] at hF,
    replace hF := congr_fun hF s, dsimp at hF,
    -- change sum from ℤ to ℕ
    --rw nnreal.summable_iff_on_nat_less F.d, swap,
    --{ intros n hn, simp [if_neg hn.not_le] },
    have h1 : ∀ (n : ℤ),
      ite (F.d ≤ n) (∑ (l : ℕ) in range (n - F.d).nat_abs.succ, (F s (n - 1 - ↑l) : ℝ) * 2 ^ l) 0 =
      ite (F.d ≤ n) (-(2 : ℝ)^(n-1)*∑' (k : ℕ), F s (n + k) * 2⁻¹ ^ (n + k)) 0,
    { intro n,
      split_ifs with hn, swap, refl,
      rw [← inv_mul_eq_iff_eq_mul₀, ← neg_inv, neg_mul, mul_sum, neg_eq_iff_add_eq_zero, ← hF],
        swap, exact neg_ne_zero.2 (zpow_ne_zero _ two_ne_zero),
      convert @tsum_add_tsum_compl ℝ ℤ _ _ _ _ _ {x : ℤ | x < n}
        (summable.subtype (F.summable_half s) _) (summable.subtype (F.summable_half s) _) using 2,
      { simp_rw [← inv_zpow, mul_comm ((2⁻¹ : ℝ)^(n-1)), mul_assoc],
        simp_rw (show ∀ (x : ℕ), (2 : ℝ)^x = 2⁻¹^(-(x : ℤ)), by {intros, simp}),
        simp_rw [← zpow_add₀ (by norm_num : (2⁻¹ : ℝ) ≠ 0), add_comm, ← sub_eq_add_neg],
        rw ← tsum_eq_sum,
        convert @equiv.tsum_eq ℝ _ _ _ _ _
          (⟨λ m, ⟨n - 1 - m, lt_of_le_of_lt (sub_le_self _ (int.coe_zero_le m)) (sub_one_lt n)⟩,
           (λ z, (n - 1 - z.1).nat_abs), λ m, by simp, λ ⟨z, hz⟩, subtype.ext begin
--             squeeze_simp,
             change n - 1 - (n - 1 - z).nat_abs = z,
             rw ← int.eq_nat_abs_of_zero_le (sub_nonneg_of_le (int.le_sub_one_of_lt hz)),
             ring, end⟩ : ℕ ≃ {z : ℤ // z < n}) _,
        { ext, refl },
        { intros b hb,
          rw mul_eq_zero, left,
          norm_cast,
          apply lt_d_eq_zero,
          by_contra h, push_neg at h, apply hb,
          rw [mem_range, nat.succ_eq_add_one, ← int.coe_nat_lt, int.coe_nat_add,
            ← int.eq_nat_abs_of_zero_le]; linarith } },
      { convert @equiv.tsum_eq ℝ _ _ _ _ _
          (⟨λ x, ⟨n + x, (int.le.intro rfl).not_lt⟩, (λ z, (z.1 - n).nat_abs),
            λ x, by simp, λ ⟨x, hx⟩, subtype.ext begin
              change n + _ = x,
              rw ← int.eq_nat_abs_of_zero_le (sub_nonneg.2 (le_of_not_lt hx)),
              exact add_eq_of_eq_sub' rfl,
            end⟩ : ℕ ≃ {z : ℤ // ¬ z < n}) _,
        ext, refl },
    },
    suffices : summable (λ (n : ℤ),
     ∥ite (F.d ≤ n) (-(2 : ℝ)^(n-1)*∑' (k : ℕ), ↑(F s (n + k)) * 2⁻¹ ^ (n + k)) 0∥₊ *
       r ^ n),
    { refine (summable_congr _).2 this,
      intro n,
      congr' 2,
      apply h1 n,
    }, clear h1,
    clear hF,
    exact psi_def_aux F s,
  end }

theorem θ_ϕ_split_exact (F : ℒ S) (hF : θ F = 0) : ϕ (ψ F hF) = F :=
begin
  ext s n,
  simp only [ϕ, ψ, sub_apply, shift_to_fun_to_fun, laurent_measures.coe_mk, nsmul_apply,
    nsmul_eq_mul, int.nat_cast_eq_coe_nat, int.coe_nat_succ, int.coe_nat_zero, zero_add],
  split_ifs with h1 h2,
  { rw [sum_range_succ', (by norm_num : (1 : ℤ) + 1 = 2), mul_sum],
    convert add_sub_cancel' _ _,
    { rw [nat.succ_eq_add_one, (by ring : n + 1 - F.d = n - F.d + 1)],
      obtain ⟨m, hm⟩ := (int.eq_coe_of_zero_le (sub_nonneg.mpr h2)),
      rw hm,
      norm_cast },
    { ext,
      push_cast,
      ring_exp,
      congr' 2,
      ring },
    { simp } },
  { have hF : F.d = n + 1, linarith,
    simp [hF] },
  { linarith },
  { exact (lt_d_eq_zero F s n (not_le.mp h)).symm },
end

theorem θ_ϕ_exact (F : ℒ S) (hF : θ F = 0) : ∃ G, ϕ G = F :=
⟨ψ F hF, θ_ϕ_split_exact F hF⟩

end mem_exact