/- -----------------------------------------------------------------------
Limits and co-limits.
----------------------------------------------------------------------- -/

import ..c1_basic

namespace qp

open stdaux

universe variables ℓobjx ℓhomx ℓobj ℓhom ℓobj₁ ℓhom₁ ℓobj₂ ℓhom₂ ℓobj₃ ℓhom₃

/- -----------------------------------------------------------------------
Limits.
----------------------------------------------------------------------- -/

/-! #brief A limit of a functor.
-/
@[class] definition HasLimit {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (L : Fun X C)
:= HasFinal (ConeCat L)

instance HasLimit.ConeCat_HasFinal {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (L : Fun X C)
    [L_HasLimit : HasLimit L]
    : HasFinal (ConeCat L)
:= L_HasLimit

/-! #brief Casting a HasLimit along heterogeneous equality.
-/
definition HasLimit.heq
    : ∀ {X₁ X₂ : Cat.{ℓobjx ℓhomx}}
        (ωX : X₁ = X₂)
        {C₁ C₂ : Cat.{ℓobj₁ ℓhom₁}}
        (ωC : C₁ = C₂)
        {L₁ : Fun X₁ C₁} {L₂ : Fun X₂ C₂}
        (ωL : L₁ == L₂)
      , HasLimit L₁ = HasLimit L₂
| X .(X) (eq.refl .(X)) C .(C) (eq.refl .(C)) L .(L) (heq.refl .(L)) := rfl

/-! #brief A category with all limits out of another category.
-/
class HasAllLimitsFrom (C : Cat.{ℓobj₁ ℓhom₁}) (X : Cat.{ℓobjx ℓhomx})
:= (has_limit : ∀ (L : Fun X C), HasLimit L)

instance HasAllLimitsFrom.HasLimit (C : Cat.{ℓobj₁ ℓhom₁}) {X : Cat.{ℓobjx ℓhomx}}
    (L : Fun X C)
    [C_HasAllLimitsFrom_X : HasAllLimitsFrom C X]
    : HasLimit L
:= HasAllLimitsFrom.has_limit L

/-! #brief A category with all limits.
-/
class HasAllLimits (C : Cat.{ℓobj₁ ℓhom₁})
:= (has_limit : ∀ {X : Cat.{ℓobjx ℓhomx}} (L : Fun X C)
                , HasLimit L)

instance HasAllLimits.HasAllLimitsFrom (C : Cat.{ℓobj₁ ℓhom₁})
    [C_HasAllLimits : HasAllLimits.{ℓobjx ℓhomx ℓobj₁ ℓhom₁} C]
    (X : Cat.{ℓobjx ℓhomx})
    : HasAllLimitsFrom C X
:= { has_limit := λ L, HasAllLimits.has_limit L
   }

instance HasAllLimits.HasLimit {C : Cat.{ℓobj₁ ℓhom₁}}
    [C_HasAllLimits : HasAllLimits.{ℓobjx ℓhomx ℓobj₁ ℓhom₁} C]
    {X : Cat.{ℓobjx ℓhomx}} (L : Fun X C)
    : HasLimit L
:= HasAllLimits.has_limit L

/-! #brief Helper for showing a functor has a limit.
-/
definition HasLimit.show {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L : Fun X C}
    (l : C^.obj)
    (out : ∀ (x : X^.obj), C^.hom l (L^.obj x))
    (ωout : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
             , out x₂ = C^.circ (L^.hom f) (out x₁))
    (univ
      : ∀ (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom c (L^.obj x))
          (comm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                  , hom x₂ = C^.circ (L^.hom f) (hom x₁))
        , C^.hom c l)
    (ωuniv
      : ∀ (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom c (L^.obj x))
          (comm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                  , hom x₂ = C^.circ (L^.hom f) (hom x₁))
          (x : X^.obj)
        , hom x = C^.circ (out x) (univ c hom @comm))
    (ωuniq
      : ∀ (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom c (L^.obj x))
          (comm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                  , hom x₂ = C^.circ (L^.hom f) (hom x₁))
          (f : C^.hom c l)
          (ωf : ∀ (x : X^.obj), hom x = C^.circ (out x) f)
        , f = univ c hom @comm)
    : HasLimit L
:= HasFinal.show
    { obj := l, hom := out, comm := @ωout }
    (λ cone, { mediate := univ cone^.obj cone^.hom (@Cone.comm _ _ _ cone)
             , factor := ωuniv cone^.obj cone^.hom (@Cone.comm _ _ _ cone)
             })
   (λ cone cone_hom
    , ConeHom.eq (ωuniq
                   cone^.obj cone^.hom (@Cone.comm _ _ _ cone)
                   cone_hom^.mediate cone_hom^.factor))

/-! #brief Limits are cones.
-/
definition limit.cone {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasLimit : HasLimit F]
    : Cone F
:= final (ConeCat F)

/-! #brief The limit object of a functor.
-/
definition limit {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasLimit : HasLimit F]
    : C^.obj
:= (limit.cone F)^.obj

/-! #brief A map out of the limit.
-/
definition limit.out {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasLimit : HasLimit F]
    (x : X^.obj)
    : C^.hom (limit F) (F^.obj x)
:= (final (ConeCat F))^.hom x

/-! #brief The limit-out maps commute with the diagram.
-/
theorem limit.out.comm {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasLimit : HasLimit F]
    {x₁ x₂ : X^.obj}
    (f : X^.hom x₁ x₂)
    : limit.out F x₂ = C^.circ (F^.hom f) (limit.out F x₁)
:= (final (ConeCat F))^.comm f

/-! #brief Every cone is mediated through the limit.
-/
definition limit.univ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasLimit : HasLimit F]
    (c : Cone F)
    : C^.hom c^.obj (limit F)
:= (@final_hom (ConeCat F) _ c)^.mediate

/-! #brief Every cone is mediated through the limit.
-/
theorem limit.univ.mediates {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    {F_HasLimit : HasLimit F}
    (c : Cone F)
    (x : X^.obj)
    : c^.hom x = C^.circ (limit.out F x) (limit.univ F c)
:= (@final_hom (ConeCat F) _ c)^.factor x

/-! #brief The mediating map from a cone to the limit is unique.
-/
theorem limit.univ.uniq {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    {F_HasLimit : HasLimit F}
    (c : Cone F)
    (m : C^.hom c^.obj (limit F))
    (ω : ∀ (x : X^.obj), c^.hom x = limit.out F x ∘∘ m)
    : m = limit.univ F c
:= let m' : ConeHom F c (limit.cone F)
         := { mediate := m
            , factor := ω
            } in
   let ωm' : m' = @final_hom (ConeCat F) _ c
          := final_hom.uniq (ConeCat F)
   in congr_arg ConeHom.mediate ωm'

/-! #brief The unique iso between two limits of the same functor.
-/
definition limit.iso {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    (F_HasLimit₁ F_HasLimit₂ : HasLimit F)
    : C^.hom (@limit X C F F_HasLimit₁) (@limit X C F F_HasLimit₂)
:= @limit.univ X C F F_HasLimit₂ (@limit.cone X C F F_HasLimit₁)

/-! #brief Limits are unique up-to unique isomorphism.
-/
theorem limit.uniq {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    (F_HasLimit₁ F_HasLimit₂ : HasLimit F)
    : Iso (limit.iso F_HasLimit₁ F_HasLimit₂)
          (limit.iso F_HasLimit₂ F_HasLimit₁)
:= { id₁ := eq.trans (eq.symm ConeHom.comp.simp_mediate)
                     (congr_arg ConeHom.mediate (HasFinal_uniq F_HasLimit₁ F_HasLimit₂)^.id₁)
   , id₂ := eq.trans (eq.symm ConeHom.comp.simp_mediate)
                     (congr_arg ConeHom.mediate (HasFinal_uniq F_HasLimit₁ F_HasLimit₂)^.id₂)
   }

/-! #brief limit.univ absorbs compositions.
-/
theorem limit.circ_univ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    {F_HasLimit : HasLimit F}
    (cone : Cone F)
    {c' : C^.obj} (f : C^.hom c' cone^.obj)
    : @limit.univ X C F F_HasLimit cone ∘∘ f
       = @limit.univ X C F F_HasLimit (cone^.circ f)
:= begin
     refine limit.univ.uniq (cone^.circ f) _ _,
     intro x,
     dsimp [Cone.circ],
     rw C^.circ_assoc,
     apply Cat.circ.congr_left,
     apply limit.univ.mediates
   end

/- -----------------------------------------------------------------------
Preservation of limits by functors.
----------------------------------------------------------------------- -/

/-! #brief A functor which preserves a limit.
-/
@[class] definition PresLimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B)
    (F : Fun B C)
:= PresFinal (LeftConeFun F L)

/-! #brief A functor which preserves colimits out of a given category.
-/
class PresLimitsFrom {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun B C)
    (X : Cat.{ℓobjx ℓhomx})
:= (pres_limit : ∀ (L : Fun X B)
                 , PresLimit L F)

instance PresLimitsFrom.PresLimit {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun B C)
    {X : Cat.{ℓobjx ℓhomx}}
    [F_PresLimitsFrom : PresLimitsFrom F X]
    (L : Fun X B)
    : PresLimit L F
:= PresLimitsFrom.pres_limit F L

/-! #brief Functors which preserve limits yield instances of HasLimit.
-/
instance PresLimit.HasLimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasLimit : HasLimit L]
    (F : Fun B C) [F_PresLimit : PresLimit L F]
    : HasLimit (Fun.comp F L)
:= @PresFinal.HasFinal _ _ L_HasLimit (LeftConeFun F L) F_PresLimit

/-! #brief Helper for showing that a functor preserves a limit.
-/
definition PresLimit.show {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun X B}
    {F : Fun B C}
    (mediate
      : ∀ [L_HasLimit : HasLimit L]
          (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom c (F^.obj (L^.obj x)))
          (ωcomm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                   , hom x₂ = C^.circ (F^.hom (L^.hom f)) (hom x₁))
        , C^.hom c (F^.obj (limit L)))
    (ωmediate
      : ∀ [L_HasLimit : HasLimit L]
          (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom c (F^.obj (L^.obj x)))
          (ωcomm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                   , hom x₂ = C^.circ (F^.hom (L^.hom f)) (hom x₁))
          (x : X^.obj)
        , hom x = F^.hom (limit.out L x) ∘∘ mediate c hom @ωcomm)
    (ωuniq
      : ∀ [L_HasLimit : HasLimit L]
          (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom c (F^.obj (L^.obj x)))
          (ωcomm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                   , hom x₂ = C^.circ (F^.hom (L^.hom f)) (hom x₁))
          (f : C^.hom c (F^.obj (limit L)))
          (ωf : ∀ (x : X^.obj), hom x = C^.circ (F^.hom (limit.out L x)) f)
        , f = mediate c hom @ωcomm)
    : PresLimit L F
:= { hom := λ L_HasLimit cone
            , { mediate := @mediate L_HasLimit cone^.obj cone^.hom (@Cone.comm _ _ _ cone)
              , factor := @ωmediate L_HasLimit cone^.obj cone^.hom (@Cone.comm _ _ _ cone)
              }
   , pres := λ L_HasLimit
             , { hom_uniq := λ cone h, ConeHom.eq (@ωuniq L_HasLimit cone^.obj cone^.hom (@Cone.comm _ _ _ cone)
                                                     h^.mediate h^.factor)
               }
   }

/-! #brief Preservation of limits by compositions of functors.
-/
definition PresLimit.comp {X : Cat.{ℓobjx ℓhomx}}
    {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    (L : Fun X B)
    (F : Fun B C) [F_PresLimit : PresLimit L F]
    (G : Fun C D) [G_PresLimit : PresLimit (Fun.comp F L) G]
    : PresLimit L (Fun.comp G F)
:= sorry -- TODO: prove by showing preservation of final composes.

/-! #brief A limit of a functor.
-/
theorem preslimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasLimit : HasLimit L]
    (F : Fun B C) [F_PresLimit : PresLimit L F]
    : limit (Fun.comp F L) = F^.obj (limit L)
:= rfl

/-! #brief A map out of the limit.
-/
theorem preslimit.out {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasLimit : HasLimit L]
    (F : Fun B C) [F_PresLimit : PresLimit L F]
    (x : X^.obj)
    : limit.out (Fun.comp F L) x = F^.hom (limit.out L x)
:= rfl

/-! #brief Every cone is mediated through the limit.
-/
definition preslimit.univ {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasLimit : HasLimit L]
    (F : Fun B C) [F_PresLimit : PresLimit L F]
    (c : Cone L)
    : limit.univ _ ((LeftConeFun F L)^.obj c) = by exact F^.hom (limit.univ _ c)
:= begin
     apply eq.symm,
     apply limit.univ.uniq ((LeftConeFun F L)^.obj c),
     intro x,
     dsimp [LeftConeFun],
     rw preslimit.out,
     refine eq.trans _ F^.hom_circ,
     rw limit.univ.mediates c x,
     trivial
   end

/- -----------------------------------------------------------------------
Final objects as limits.
----------------------------------------------------------------------- -/

/-! #brief If the initial functor has a limit, then the category has a final.
-/
instance InitFun.HasLimit_HasFinal {C : Cat.{ℓobj ℓhom}}
    [InitFun_HasLimit : HasLimit (InitFun.{ℓobjx ℓhomx} C)]
    : HasFinal C
:= let mkcone : C^.obj → Cone (InitFun.{ℓobjx ℓhomx} C)
             := λ c, { obj := c
                     , hom := λ e, by cases e
                     , comm := λ e₁ e₂ f, by cases f
                     }
   in HasFinal.show
       (limit (InitFun.{ℓobjx ℓhomx} C))
       (λ c, limit.univ _ (mkcone c))
       (λ c h, limit.univ.uniq (mkcone c) h (λ e, by cases e))

/-! #brief If the category has a final, then the initial functor has a limit.
-/
definition InitFun.HasFinal_HasLimit {C : Cat.{ℓobj ℓhom}}
    [HasFinal C]
    : HasLimit (InitFun.{ℓobjx ℓhomx} C)
:= HasLimit.show (final C) (λ e, by cases e) (λ x₁ x₂ f, by cases f)
    (λ c hom ωcomm, final_hom c)
    (λ c hom ωcomm e, by cases e)
    (λ c hom ωcomm f e, final_hom.uniq C)

/-! #brief Functors which preserve limits of the initial functor preserve final objects.
-/
instance PresLimit.InitFun_PresFinal {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun C D)
    [F_PresLimit : PresLimit (InitFun.{ℓobjx ℓhomx} C) F]
    : PresFinal F
:= let mk_cone : ∀ (d : D^.obj), Cone (F □□ InitFun.{ℓobjx ℓhomx} C)
              := λ d, { obj := d
                      , hom := λ e, by cases e
                      , comm := λ e₁ e₂ f, by cases f
                      } in
   let mk_lim : ∀ (C_HasFinal : HasFinal C)
                , HasLimit (F □□ InitFun.{ℓobjx ℓhomx} C)
             := λ C_HasFinal, @PresLimit.HasLimit _ _ _
                               _ (@InitFun.HasFinal_HasLimit C C_HasFinal)
                               _ F_PresLimit
   in { hom := λ C_HasFinal d, @limit.univ _ _ _ (mk_lim C_HasFinal) (mk_cone d)
      , pres := λ C_HasFinal
                , { hom_uniq := λ d h
                                , begin
                                    apply (@limit.univ.uniq _ _ _ (mk_lim C_HasFinal) (mk_cone d) h _),
                                    { intro e, cases e }
                                  end
                  }
      }

/- -----------------------------------------------------------------------
The limit functor.
----------------------------------------------------------------------- -/

/-! #brief The cone used by the limit functor.
-/
definition LimitFun.cone {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj ℓhom}}
    [C_HasAllLimitsFrom_X : HasAllLimitsFrom C X]
    (L₁ L₂ : Fun X C) (η : NatTrans L₁ L₂)
    : Cone L₂
:= { obj := limit L₁
   , hom := λ x, η^.com x ∘∘ limit.out L₁ x
   , comm := λ x₁ x₂ f
             , begin
                 rw C^.circ_assoc,
                 rw -(η^.natural f),
                 rw -C^.circ_assoc,
                 apply Cat.circ.congr_right,
                 apply limit.out.comm
               end
   }

/-! #brief The limit functor.
-/
definition LimitFun {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj ℓhom}}
    [C_HasAllLimitsFrom_X : HasAllLimitsFrom C X]
    : Fun (FunCat X C) C
:= { obj := λ L, limit L
   , hom := λ L₁ L₂ η, limit.univ L₂ (LimitFun.cone L₁ L₂ η)
   , hom_id := λ L, begin
                      apply eq.symm,
                      apply limit.univ.uniq (LimitFun.cone L L (NatTrans.id L)),
                      intro x,
                      exact eq.trans C^.circ_id_left (eq.symm C^.circ_id_right)
                    end
   , hom_circ
      := λ L₁ L₂ L₃ η₂₃ η₁₂
         , begin
             apply eq.symm,
             apply limit.univ.uniq (LimitFun.cone L₁ L₃ (NatTrans.comp η₂₃ η₁₂)),
             intro x,
             refine eq.trans _ (eq.symm (Cat.circ.congr_right (limit.circ_univ L₃ (LimitFun.cone L₂ L₃ η₂₃) (limit.univ L₂ (LimitFun.cone L₁ L₂ η₁₂))))),
             refine eq.trans _ (limit.univ.mediates (Cone.circ (LimitFun.cone L₂ L₃ η₂₃) (limit.univ L₂ (LimitFun.cone L₁ L₂ η₁₂))) x),
             apply eq.trans (eq.symm C^.circ_assoc),
             refine eq.symm (eq.trans (eq.symm C^.circ_assoc) (eq.symm _)),
             apply Cat.circ.congr_right,
             exact limit.univ.mediates (LimitFun.cone L₁ L₂ η₁₂) x
           end
   }

/- -----------------------------------------------------------------------
Limits in functor categories.
----------------------------------------------------------------------- -/

/-! #brief Projection for pointwise limits.
-/
definition FunCat.HasLimit.out {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllLimitsFrom_X : HasAllLimitsFrom D X]
    (F : Fun X (FunCat C D))
    (x : X^.obj)
    : NatTrans (LimitFun □□ Fun.swap F) (F^.obj x)
:= { com := λ c, limit.out (Fun.swap.obj F c) x
   , natural := λ c₁ c₂ f
                , eq.symm (limit.univ.mediates
                            (LimitFun.cone
                              (Fun.swap.obj F c₁) (Fun.swap.obj F c₂)
                              (Fun.swap.hom F c₁ c₂ f))
                            x)
   }

/-! #brief Cone used for pointwise universal maps.
-/
definition FunCat.HasLimit.univ.cone {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllLimitsFrom_X : HasAllLimitsFrom D X]
    (F : Fun X (FunCat C D))
    (L : Fun C D)
    (η : ∀ (x : X^.obj), NatTrans L (F^.obj x))
    (ωη : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
          , η x₂ = NatTrans.comp (F^.hom f) (η x₁))
    (c : C^.obj)
    : Cone (Fun.swap.obj F c)
:= { obj := L^.obj c
   , hom := λ x, (η x)^.com c
   , comm := λ c₁ c₂ f
             , begin
                 rw ωη f,
                 trivial
               end
   }

/-! #brief Universal map for pointwise limits.
-/
definition FunCat.HasLimit.univ {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllLimitsFrom_X : HasAllLimitsFrom D X]
    (F : Fun X (FunCat C D))
    (L : Fun C D)
    (η : ∀ (x : X^.obj), NatTrans L (F^.obj x))
    (ωη : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
          , η x₂ = NatTrans.comp (F^.hom f) (η x₁))
    : NatTrans L (LimitFun □□ Fun.swap F)
:= { com := λ c, limit.univ (Fun.swap.obj F c) (FunCat.HasLimit.univ.cone F L η @ωη c)
   , natural := λ c₁ c₂ f
                , begin
                    dsimp [LimitFun],
                    apply eq.trans (limit.circ_univ (Fun.swap.obj F c₂) (FunCat.HasLimit.univ.cone F L η @ωη c₂) (L^.hom f)),
                    apply eq.symm,
                    apply eq.trans (limit.circ_univ ((Fun.swap F)^.obj c₂)
                                    (LimitFun.cone ((Fun.swap F)^.obj c₁) ((Fun.swap F)^.obj c₂) ((Fun.swap F)^.hom f))
                                    (limit.univ (Fun.swap.obj F c₁) (FunCat.HasLimit.univ.cone F L η @ωη c₁))),
                    apply limit.univ.uniq (Cone.circ (FunCat.HasLimit.univ.cone F L η @ωη c₂) (L^.hom f)),
                    intro x,
                    apply eq.trans ((η x)^.natural f),
                    refine eq.trans _ (limit.univ.mediates (Cone.circ (LimitFun.cone ((Fun.swap F)^.obj c₁) ((Fun.swap F)^.obj c₂) ((Fun.swap F)^.hom f)) (limit.univ (Fun.swap.obj F c₁) (FunCat.HasLimit.univ.cone F L η @ωη c₁))) x),
                    refine eq.symm (eq.trans (eq.symm D^.circ_assoc) (eq.symm _)),
                    apply Cat.circ.congr_right,
                    apply limit.univ.mediates (FunCat.HasLimit.univ.cone F L η @ωη c₁) x
                  end
   }

/-! #brief Limits in FunCat can be computed pointwise.
-/
instance FunCat.HasLimit {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllLimitsFrom_X : HasAllLimitsFrom D X]
    (F : Fun X (FunCat C D))
    : HasLimit F
:= HasLimit.show
     (LimitFun □□ F^.swap)
     (FunCat.HasLimit.out F)
     (λ x₁ x₂ f
      , begin
          apply NatTrans.eq, apply funext, intro c,
          apply limit.out.comm
        end)
     (FunCat.HasLimit.univ F)
     (λ L hom ωhom x
      , begin
          apply NatTrans.eq, apply funext, intro c,
          apply limit.univ.mediates (FunCat.HasLimit.univ.cone F L hom @ωhom c)
        end)
     (λ L hom ωhom h ωh
      , begin
          apply NatTrans.eq, apply funext, intro c,
          apply limit.univ.uniq (FunCat.HasLimit.univ.cone F L hom @ωhom c),
          intro x,
          apply NatTrans.congr_com (ωh x)
        end)

/-! #brief Limits in functor categories can be computed pointwise.
-/
instance FunCat.HasAllLimits {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllLimits : HasAllLimits.{ℓobjx ℓhomx} D]
    : HasAllLimits.{ℓobjx ℓhomx} (FunCat C D)
:= { has_limit := λ X L, @FunCat.HasLimit C D X (HasAllLimits.HasAllLimitsFrom D X) L
   }

/- -----------------------------------------------------------------------
Limits and natural isomorphisms.
----------------------------------------------------------------------- -/

/-! #brief Natural isomorphism cast limits (cone used for universal).
-/
definition NatIso.HasLimit.cone {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L₁ L₂ : Fun X C}
    {η₁₂ : NatTrans L₁ L₂}
    {η₂₁ : NatTrans L₂ L₁}
    (η_iso : NatIso η₁₂ η₂₁)
    [L₁_HasLimit : HasLimit L₁]
    (c : C^.obj)
    (hom : Π (x : ⟦X⟧), ⟦C : c →→ L₂^.obj x⟧)
    (ωhom : ∀ {x₁ x₂ : ⟦X⟧} (f : ⟦X : x₁ →→ x₂⟧), hom x₂ = L₂^.hom f ∘∘ hom x₁)
    : Cone L₁
:= { obj := c
   , hom := λ x, η₂₁^.com x ∘∘ hom x
   , comm := λ x₁ x₂ f
             , begin
                 rw C^.circ_assoc,
                 rw -(η₂₁^.natural f),
                 rw -C^.circ_assoc,
                 apply Cat.circ.congr_right,
                 apply ωhom
               end
   }

/-! #brief Natural isomorphism cast limits.
-/
definition NatIso.HasLimit₂ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L₁ L₂ : Fun X C}
    {η₁₂ : NatTrans L₁ L₂}
    {η₂₁ : NatTrans L₂ L₁}
    (η_iso : NatIso η₁₂ η₂₁)
    [L₁_HasLimit : HasLimit L₁]
    : HasLimit L₂
:= HasLimit.show (limit L₁)
    (λ x, η₁₂^.com x ∘∘ limit.out L₁ x)
    (λ x₁ x₂ f
     , begin
         rw C^.circ_assoc,
         rw -(η₁₂^.natural f),
         rw -C^.circ_assoc,
         apply Cat.circ.congr_right,
         apply limit.out.comm
       end)
    (λ c hom ωhom, limit.univ L₁ (NatIso.HasLimit.cone η_iso c hom @ωhom))
    (λ c hom ωhom x
     , begin
         rw -C^.circ_assoc,
         apply eq.symm,
         apply eq.trans (eq.symm (Cat.circ.congr_right (limit.univ.mediates (NatIso.HasLimit.cone η_iso c hom @ωhom) x))),
         apply eq.trans C^.circ_assoc,
         apply eq.trans (Cat.circ.congr_left (NatTrans.congr_com η_iso^.id₂)),
         apply C^.circ_id_left
       end)
    (λ c hom ωhom h ωh
     , begin
         apply limit.univ.uniq (NatIso.HasLimit.cone η_iso c hom @ωhom),
         intro x,
         apply eq.trans (Cat.circ.congr_right (ωh x)),
         repeat { rw C^.circ_assoc },
         apply Cat.circ.congr_left,
         apply eq.trans (Cat.circ.congr_left (NatTrans.congr_com η_iso^.id₁)),
         apply C^.circ_id_left
       end)

/-! #brief Natural isomorphism cast limits.
-/
definition NatIso.HasLimit₁ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L₁ L₂ : Fun X C}
    {η₁₂ : NatTrans L₁ L₂}
    {η₂₁ : NatTrans L₂ L₁}
    (η_iso : NatIso η₁₂ η₂₁)
    [L₂_HasLimit : HasLimit L₂]
    : HasLimit L₁
:= NatIso.HasLimit₂ η_iso^.flip

/- -----------------------------------------------------------------------
Co-limits.
----------------------------------------------------------------------- -/

/-! #brief A co-limit of a functor.
-/
@[class] definition HasCoLimit {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (L : Fun X C)
:= HasLimit (OpFun L)

instance HasCoLimit.Op_HasLimit {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (L : Fun X C)
    [L_HasCoLimit : HasCoLimit L]
    : HasLimit (OpFun L)
:= L_HasCoLimit

/-! #brief Casting a HasCoLimit along heterogeneous equality.
-/
definition HasCoLimit.heq
    : ∀ {X₁ X₂ : Cat.{ℓobjx ℓhomx}}
        (ωX : X₁ = X₂)
        {C₁ C₂ : Cat.{ℓobj₁ ℓhom₁}}
        (ωC : C₁ = C₂)
        {L₁ : Fun X₁ C₁} {L₂ : Fun X₂ C₂}
        (ωL : L₁ == L₂)
      , HasCoLimit L₁ = HasCoLimit L₂
| X .(X) (eq.refl .(X)) C .(C) (eq.refl .(C)) L .(L) (heq.refl .(L)) := rfl

/-! #brief A category with all co-limits.
-/
class HasAllCoLimits (C : Cat.{ℓobj₁ ℓhom₁})
:= (has_colimit : ∀ {X : Cat.{ℓobjx ℓhomx}} (L : Fun X C)
                  , HasCoLimit L)

instance HasAllCoLimits.HasCoLimit {C : Cat.{ℓobj₁ ℓhom₁}}
    [C_HasAllCoLimits : HasAllCoLimits.{ℓobjx ℓhomx ℓobj₁ ℓhom₁} C]
    {X : Cat.{ℓobjx ℓhomx}} (L : Fun X C)
    : HasCoLimit L
:= HasAllCoLimits.has_colimit L

/-! #brief A category with all co-limits out of another category.
-/
class HasAllCoLimitsFrom (C : Cat.{ℓobj₁ ℓhom₁}) (X : Cat.{ℓobjx ℓhomx})
:= (has_colimit : ∀ (L : Fun X C), HasCoLimit L)

instance HasAllCoLimitsFrom.HasCoLimit (C : Cat.{ℓobj₁ ℓhom₁}) {X : Cat.{ℓobjx ℓhomx}}
    (L : Fun X C)
    [C_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom C X]
    : HasCoLimit L
:= HasAllCoLimitsFrom.has_colimit L

instance HasAllCoLimits.HasAllCoLimitsFrom (C : Cat.{ℓobj₁ ℓhom₁})
    [C_HasAllCoLimits : HasAllCoLimits.{ℓobjx ℓhomx} C]
    (X : Cat.{ℓobjx ℓhomx})
    : HasAllCoLimitsFrom C X
:= { has_colimit := λ L, HasAllCoLimits.has_colimit L
   }

/-! #brief Helper for showing a functor has a co-limit.
-/
definition HasCoLimit.show {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L : Fun X C}
    (l : C^.obj)
    (into : ∀ (x : X^.obj), C^.hom (L^.obj x) l)
    (ωinto : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
             , into x₁ = C^.circ (into x₂) (L^.hom f))
    (univ
      : ∀ (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom (L^.obj x) c)
          (comm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                  , hom x₁ = C^.circ (hom x₂) (L^.hom f))
        , C^.hom l c)
    (ωuniv
      : ∀ (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom (L^.obj x) c)
          (comm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                  , hom x₁ = C^.circ (hom x₂) (L^.hom f))
          (x : X^.obj)
        , hom x = C^.circ (univ c hom @comm) (into x))
    (ωuniq
      : ∀ (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom (L^.obj x) c)
          (comm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                  , hom x₁ = C^.circ (hom x₂) (L^.hom f))
          (f : C^.hom l c)
          (ωf : ∀ (x : X^.obj), hom x = C^.circ f (into x))
        , f = univ c hom @comm)
    : HasCoLimit L
:= HasLimit.show
    l into (λ x₂ x₁ f, ωinto f)
    (λ c hom comm, univ c hom (λ x₂ x₁ f, comm f))
    (λ c hom comm, ωuniv c hom (λ x₂ x₁ f, comm f))
    (λ c hom comm, ωuniq c hom (λ x₂ x₁ f, comm f))

/-! #brief Co-limits are co-cones.
-/
definition colimit.cocone {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasCoLimit : HasCoLimit F]
    : CoCone F
:= limit.cone (OpFun F)

/-! #brief The co-limit object of a functor.
-/
definition colimit {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasCoLimit : HasCoLimit F]
    : C^.obj
:= @limit (OpCat X) (OpCat C) (OpFun F) F_HasCoLimit

/-! #brief A map into the colimit.
-/
definition colimit.in {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasCoLimit : HasCoLimit F]
    (x : X^.obj)
    : C^.hom (F^.obj x) (colimit F)
:= limit.out (OpFun F) x

/-! #brief The co-limit-in maps commute with the diagram.
-/
theorem colimit.in.comm {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    [F_HasCoLimit : HasCoLimit F]
    {x₁ x₂ : X^.obj}
    (f : X^.hom x₁ x₂)
    : colimit.in F x₁ = C^.circ (colimit.in F x₂) (F^.hom f)
:= limit.out.comm (OpFun F) f

/-! #brief Every co-cone is mediated through the co-limit.
-/
definition colimit.univ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    {F_HasCoLimit : HasCoLimit F}
    (c : CoCone F)
    : C^.hom (colimit F) c^.obj
:= limit.univ _ c

/-! #brief Every co-cone is mediated through the co-limit.
-/
theorem colimit.univ.mediates {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    {F_HasCoLimit : HasCoLimit F}
    (c : CoCone F)
    (x : X^.obj)
    : c^.hom x = C^.circ (colimit.univ F c) (colimit.in F x)
:= limit.univ.mediates c x

/-! #brief The mediating map to a co-cone from the co-limit is unique.
-/
theorem colimit.univ.uniq {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    {F_HasCoLimit : HasCoLimit F}
    (c : CoCone F)
    (m : C^.hom (colimit F) c^.obj)
    (ω : ∀ (x : X^.obj), c^.hom x = m ∘∘ colimit.in F x)
    : m = colimit.univ F c
:= limit.univ.uniq c m ω

/-! #brief The unique iso between two co-limits of the same functor.
-/
definition colimit.iso {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    (F_HasCoLimit₁ F_HasCoLimit₂ : HasCoLimit F)
    : C^.hom (@colimit X C F F_HasCoLimit₁) (@colimit X C F F_HasCoLimit₂)
:= limit.iso F_HasCoLimit₂ F_HasCoLimit₁

/-! #brief Co-limits are unique up-to unique isomorphism.
-/
theorem colimit.uniq {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {F : Fun X C}
    (F_HasCoLimit₁ F_HasCoLimit₂ : HasCoLimit F)
    : Iso (limit.iso F_HasCoLimit₁ F_HasCoLimit₂)
          (limit.iso F_HasCoLimit₂ F_HasCoLimit₁)
:= limit.uniq F_HasCoLimit₁ F_HasCoLimit₂

/-! #brief limit.univ absorbs compositions.
-/
theorem colimit.circ_univ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    (F : Fun X C)
    {F_HasCoLimit : HasCoLimit F}
    (ccone : CoCone F)
    {c' : C^.obj} (f : C^.hom ccone^.obj c')
    : f ∘∘ @colimit.univ X C F F_HasCoLimit ccone
       = @colimit.univ X C F F_HasCoLimit (ccone^.circ f)
:= begin
     refine colimit.univ.uniq (ccone^.circ f) _ _,
     intro x,
     apply eq.symm,
     apply eq.trans (eq.symm C^.circ_assoc),
     apply Cat.circ.congr_right,
     apply eq.symm,
     apply colimit.univ.mediates
   end

/- -----------------------------------------------------------------------
Preservation of co-limits by functors.
----------------------------------------------------------------------- -/

/-! #brief A functor which preserves a co-limit.
-/
@[class] definition PresCoLimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B)
    (F : Fun B C)
:= PresLimit (OpFun L) (OpFun F)

instance PresCoLimit.PresLimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B)
    (F : Fun B C)
    [F_PresCoLimit : PresCoLimit L F]
    : PresLimit (OpFun L) (OpFun F)
:= F_PresCoLimit

/-! #brief Functors which preserve co-limits yield instances of HasCoLimit.
-/
instance PresCoLimit.HasCoLimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasCoLimit : HasCoLimit L]
    (F : Fun B C) [F_PresCoLimit : PresCoLimit L F]
    : HasCoLimit (Fun.comp F L)
:= PresLimit.HasLimit (OpFun L) (OpFun F)

/-! #brief A functor which preserves colimits out of a given category.
-/
class PresCoLimitsFrom {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun B C)
    (X : Cat.{ℓobjx ℓhomx})
:= (pres_colimit : ∀ (L : Fun X B)
                   , PresCoLimit L F)

instance PresCoLimitsFrom.PresCoLimit {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun B C)
    {X : Cat.{ℓobjx ℓhomx}}
    [F_PresCoLimitsFrom : PresCoLimitsFrom F X]
    (L : Fun X B)
    : PresCoLimit L F
:= PresCoLimitsFrom.pres_colimit F L

/-! #brief Helper for showing that a functor preserves a co-limit.
-/
definition PresCoLimit.show {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun X B}
    {F : Fun B C}
    (mediate
      : ∀ [L_HasCoLimit : HasCoLimit L]
          (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom (F^.obj (L^.obj x)) c)
          (ωcomm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                   , hom x₁ = C^.circ (hom x₂) (F^.hom (L^.hom f)))
        , C^.hom (F^.obj (colimit L)) c)
    (ωmediate
      : ∀ [L_HasCoLimit : HasCoLimit L]
          (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom (F^.obj (L^.obj x)) c)
          (ωcomm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                   , hom x₁ = C^.circ (hom x₂) (F^.hom (L^.hom f)))
          (x : X^.obj)
        , hom x = mediate c hom @ωcomm ∘∘ F^.hom (colimit.in L x))
    (ωuniq
      : ∀ [L_HasCoLimit : HasCoLimit L]
          (c : C^.obj)
          (hom : ∀ (x : X^.obj), C^.hom (F^.obj (L^.obj x)) c)
          (ωcomm : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
                   , hom x₁ = C^.circ (hom x₂) (F^.hom (L^.hom f)))
          (f : C^.hom (F^.obj (colimit L)) c)
          (ωf : ∀ (x : X^.obj), hom x = C^.circ f (F^.hom (colimit.in L x)))
        , f = mediate c hom @ωcomm)
    : PresCoLimit L F
:= PresLimit.show
    (λ L_HasCoLimit c hom ωcomm, @mediate L_HasCoLimit c hom (λ x₂ x₁ f, ωcomm f))
    (λ L_HasCoLimit c hom ωcomm, @ωmediate L_HasCoLimit c hom (λ x₂ x₁ f, ωcomm f))
    (λ L_HasCoLimit c hom ωcomm, @ωuniq L_HasCoLimit c hom (λ x₂ x₁ f, ωcomm f))

/-! #brief Preservation of co-limits by compositions of functors.
-/
definition PresCoLimit.comp {X : Cat.{ℓobjx ℓhomx}}
    {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}} {D : Cat.{ℓobj₃ ℓhom₃}}
    (L : Fun X B)
    (F : Fun B C) [F_PresCoLimit : PresCoLimit L F]
    (G : Fun C D) [G_PresCoLimit : PresCoLimit (Fun.comp F L) G]
    : PresCoLimit L (Fun.comp G F)
:= @PresLimit.comp (OpCat X) (OpCat B) (OpCat C) (OpCat D)
      (OpFun L) (OpFun F) F_PresCoLimit (OpFun G) G_PresCoLimit

/-! #brief A co-limit of a functor.
-/
theorem prescolimit {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasCoLimit : HasCoLimit L]
    (F : Fun B C) [F_PresCoLimit : PresCoLimit L F]
    : colimit (Fun.comp F L) = F^.obj (colimit L)
:= preslimit (OpFun L) (OpFun F)

/-! #brief A map into the co-limit.
-/
theorem prescolimit.in {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasCoLimit : HasCoLimit L]
    (F : Fun B C) [F_PresCoLimit : PresCoLimit L F]
    (x : X^.obj)
    : colimit.in (Fun.comp F L) x = F^.hom (colimit.in L x)
:= preslimit.out (OpFun L) (OpFun F) x

/-! #brief Every co-cone is mediated through the co-limit.
-/
definition prescolimit.mediate {X : Cat.{ℓobjx ℓhomx}} {B : Cat.{ℓobj₁ ℓhom₁}} {C : Cat.{ℓobj₂ ℓhom₂}}
    (L : Fun X B) [L_HasCoLimit : HasCoLimit L]
    (F : Fun B C) [F_PresCoLimit : PresCoLimit L F]
    (c : CoCone L)
    : colimit.univ _ ((LeftCoConeFun F L)^.obj c) = by exact F^.hom (colimit.univ _ c)
:= preslimit.univ (OpFun L) (OpFun F) c

/- -----------------------------------------------------------------------
Initial objects as co-limits.
----------------------------------------------------------------------- -/

/-! #brief If the initial functor has a co-limit, then the category has a final.
-/
instance InitFun.HasCoLimit_HasInit {C : Cat.{ℓobj ℓhom}}
    [InitFun_HasCoLimit : HasCoLimit (InitFun.{ℓobjx ℓhomx} C)]
    : HasInit C
:= let mkcone : C^.obj → CoCone (InitFun.{ℓobjx ℓhomx} C)
             := λ c, { obj := c
                     , hom := λ e, by cases e
                     , comm := λ e₁ e₂ f, by cases f
                     }
   in HasInit.show
       (colimit (InitFun.{ℓobjx ℓhomx} C))
       (λ c, colimit.univ _ (mkcone c))
       (λ c h, limit.univ.uniq (mkcone c) h (λ e, by cases e))

/-! #brief If the category has an initial, then the initial functor has a co-limit.
-/
definition InitFun.HasInit_HasCoLimit {C : Cat.{ℓobj ℓhom}}
    [HasInit C]
    : HasCoLimit (InitFun.{ℓobjx ℓhomx} C)
:= HasCoLimit.show (init C) (λ e, by cases e) (λ x₁ x₂ f, by cases f)
    (λ c hom ωcomm, init_hom c)
    (λ c hom ωcomm e, by cases e)
    (λ c hom ωcomm f e, init_hom.uniq C)

/-! #brief Functors which preserve co-limits of the initial functor preserve initial objects.
-/
instance PresCoLimit.InitFun_PresInit {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    (F : Fun C D)
    [F_PresCoLimit : PresCoLimit (InitFun.{ℓobjx ℓhomx} C) F]
    : PresInit F
:= let mk_cocone : ∀ (d : D^.obj), CoCone (F □□ InitFun.{ℓobjx ℓhomx} C)
                := λ d, { obj := d
                        , hom := λ e, by cases e
                        , comm := λ e₁ e₂ f, by cases f
                        } in
   let mk_colim : ∀ (C_HasInit : HasInit C)
                  , HasCoLimit (F □□ InitFun.{ℓobjx ℓhomx} C)
               := λ C_HasInit, @PresCoLimit.HasCoLimit _ _ _
                                 _ (@InitFun.HasInit_HasCoLimit C C_HasInit)
                                 _ F_PresCoLimit
   in { hom := λ C_HasInit d, @colimit.univ _ _ _ (mk_colim C_HasInit) (mk_cocone d)
      , pres := λ C_HasInit
                , { hom_uniq := λ d h
                                , begin
                                    apply (@colimit.univ.uniq _ _ _ (mk_colim C_HasInit) (mk_cocone d) h _),
                                    { intro e, cases e }
                                  end
                  }
      }

/- -----------------------------------------------------------------------
The co-limit functor.
----------------------------------------------------------------------- -/

/-! #brief The co-cone used by the co-limit functor.
-/
definition CoLimitFun.cocone {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj ℓhom}}
    [C_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom C X]
    (L₁ L₂ : Fun X C) (η : NatTrans L₁ L₂)
    : CoCone L₁
:= CoCone.mk (colimit L₂)
    (λ x, colimit.in L₂ x ∘∘ η^.com x)
    (λ x₁ x₂ f
     , begin
         rw -C^.circ_assoc,
         rw (η^.natural f),
         rw C^.circ_assoc,
         apply Cat.circ.congr_left,
         apply colimit.in.comm
       end)

/-! #brief The co-limit functor.
-/
definition CoLimitFun {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj ℓhom}}
    [C_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom C X]
    : Fun (FunCat X C) C
:= { obj := λ L, colimit L
   , hom := λ L₁ L₂ η, colimit.univ L₁ (CoLimitFun.cocone L₁ L₂ η)
   , hom_id := λ L, begin
                      apply eq.symm,
                      apply colimit.univ.uniq (CoLimitFun.cocone L L (NatTrans.id L)),
                      intro x,
                      exact eq.trans C^.circ_id_right (eq.symm C^.circ_id_left)
                    end
   , hom_circ
      := λ L₁ L₂ L₃ η₂₃ η₁₂
         , begin
             apply eq.symm,
             apply colimit.univ.uniq (CoLimitFun.cocone L₁ L₃ (NatTrans.comp η₂₃ η₁₂)),
             intro x,
             refine eq.trans _ (eq.symm (Cat.circ.congr_left (colimit.circ_univ L₁ (CoLimitFun.cocone L₁ L₂ η₁₂) (colimit.univ L₂ (CoLimitFun.cocone L₂ L₃ η₂₃))))),
             refine eq.trans _ (colimit.univ.mediates (Cone.circ (CoLimitFun.cocone L₁ L₂ η₁₂) (colimit.univ L₂ (CoLimitFun.cocone L₂ L₃ η₂₃))) x),
             apply eq.trans C^.circ_assoc,
             refine eq.symm (eq.trans C^.circ_assoc (eq.symm _)),
             apply Cat.circ.congr_left,
             exact colimit.univ.mediates (CoLimitFun.cocone L₂ L₃ η₂₃) x
           end
   }

/- -----------------------------------------------------------------------
Co-limits in functor categories.
----------------------------------------------------------------------- -/

/-! #brief Inclusion for pointwise co-limits.
-/
definition FunCat.HasCoLimit.in {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom D X]
    (F : Fun X (FunCat C D))
    (x : X^.obj)
    : NatTrans (F^.obj x) (CoLimitFun □□ Fun.swap F)
:= { com := λ c, colimit.in (Fun.swap.obj F c) x
   , natural := λ c₁ c₂ f
                , colimit.univ.mediates
                    (CoLimitFun.cocone
                      (Fun.swap.obj F c₁) (Fun.swap.obj F c₂)
                      (Fun.swap.hom F c₁ c₂ f))
                    x
   }

/-! #brief Co-cone used for pointwise universal maps.
-/
definition FunCat.HasCoLimit.univ.cocone {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom D X]
    (F : Fun X (FunCat C D))
    (L : Fun C D)
    (η : ∀ (x : X^.obj), NatTrans (F^.obj x) L)
    (ωη : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
          , η x₁ = NatTrans.comp (η x₂) (F^.hom f))
    (c : C^.obj)
    : CoCone (Fun.swap.obj F c)
:= CoCone.mk (L^.obj c)
     (λ x, (η x)^.com c)
     (λ c₁ c₂ f
             , begin
                 rw ωη f,
                 trivial
               end)

/-! #brief Universal map for pointwise limits.
-/
definition FunCat.HasCoLimit.univ {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom D X]
    (F : Fun X (FunCat C D))
    (L : Fun C D)
    (η : ∀ (x : X^.obj), NatTrans (F^.obj x) L)
    (ωη : ∀ {x₁ x₂ : X^.obj} (f : X^.hom x₁ x₂)
          , η x₁ = NatTrans.comp (η x₂) (F^.hom f))
    : NatTrans (CoLimitFun □□ Fun.swap F) L
:= { com := λ c, colimit.univ (Fun.swap.obj F c) (FunCat.HasCoLimit.univ.cocone F L η @ωη c)
   , natural := λ c₁ c₂ f
                , begin
                    dsimp [CoLimitFun],
                    apply eq.trans (colimit.circ_univ ((Fun.swap F)^.obj c₁) (CoLimitFun.cocone ((Fun.swap F)^.obj c₁) ((Fun.swap F)^.obj c₂) ((Fun.swap F)^.hom f)) (colimit.univ (Fun.swap.obj F c₂) (FunCat.HasCoLimit.univ.cocone F L η @ωη c₂))),
                    apply eq.symm,
                    apply eq.trans (colimit.circ_univ (Fun.swap.obj F c₁) (FunCat.HasCoLimit.univ.cocone F L η @ωη c₁) (L^.hom f)),
                    apply eq.symm,
                    apply colimit.univ.uniq (CoCone.circ (FunCat.HasCoLimit.univ.cocone F L η @ωη c₁) (L^.hom f)),
                    intro x,
                    apply eq.trans (eq.symm ((η x)^.natural f)),
                    refine eq.trans _ (colimit.univ.mediates (CoCone.circ (CoLimitFun.cocone ((Fun.swap F)^.obj c₁) ((Fun.swap F)^.obj c₂) ((Fun.swap F)^.hom f)) (colimit.univ (Fun.swap.obj F c₂) (FunCat.HasCoLimit.univ.cocone F L η @ωη c₂))) x),
                    refine eq.symm (eq.trans D^.circ_assoc (eq.symm _)),
                    apply Cat.circ.congr_left,
                    apply colimit.univ.mediates (FunCat.HasCoLimit.univ.cocone F L η @ωη c₂) x
                  end
   }

/-! #brief Co-limits in FunCat can be computed pointwise.
-/
instance FunCat.HasCoLimit {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {X : Cat.{ℓobjx ℓhomx}}
    [D_HasAllCoLimitsFrom_X : HasAllCoLimitsFrom D X]
    (F : Fun X (FunCat C D))
    : HasCoLimit F
:= HasCoLimit.show
     (CoLimitFun □□ F^.swap)
     (FunCat.HasCoLimit.in F)
     (λ x₁ x₂ f
      , begin
          apply NatTrans.eq, apply funext, intro c,
          apply colimit.in.comm (Fun.swap.obj F c)
        end)
     (FunCat.HasCoLimit.univ F)
     (λ L hom ωhom x
      , begin
          apply NatTrans.eq, apply funext, intro c,
          apply colimit.univ.mediates (FunCat.HasCoLimit.univ.cocone F L hom @ωhom c)
        end)
     (λ L hom ωhom h ωh
      , begin
          apply NatTrans.eq, apply funext, intro c,
          apply colimit.univ.uniq (FunCat.HasCoLimit.univ.cocone F L hom @ωhom c),
          intro x,
          apply NatTrans.congr_com (ωh x)
        end)

/-! #brief Co-limits in functor categories can be computed pointwise.
-/
instance FunCat.HasAllCoLimits {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    [D_HasAllCoLimits : HasAllCoLimits.{ℓobjx ℓhomx} D]
    : HasAllCoLimits.{ℓobjx ℓhomx} (FunCat C D)
:= { has_colimit := λ X L, @FunCat.HasCoLimit C D X (HasAllCoLimits.HasAllCoLimitsFrom D X) L
   }

/- -----------------------------------------------------------------------
Co-limits and natural isomorphisms.
----------------------------------------------------------------------- -/

/-! #brief Natural isomorphism cast co-limits.
-/
definition NatIso.HasCoLimit₂ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L₁ L₂ : Fun X C}
    {η₁₂ : NatTrans L₁ L₂}
    {η₂₁ : NatTrans L₂ L₁}
    (η_iso : NatIso η₁₂ η₂₁)
    [L₁_HasCoLimit : HasCoLimit L₁]
    : HasCoLimit L₂
:= NatIso.HasLimit₁ (OpNatIso η_iso)

/-! #brief Natural isomorphism cast co-limits.
-/
definition NatIso.HasCoLimit₁ {X : Cat.{ℓobjx ℓhomx}} {C : Cat.{ℓobj₁ ℓhom₁}}
    {L₁ L₂ : Fun X C}
    {η₁₂ : NatTrans L₁ L₂}
    {η₂₁ : NatTrans L₂ L₁}
    (η_iso : NatIso η₁₂ η₂₁)
    [L₂_HasCoLimit : HasCoLimit L₂]
    : HasCoLimit L₁
:= NatIso.HasCoLimit₂ η_iso^.flip

/- -----------------------------------------------------------------------
Limits, colimits, and adjoints.
----------------------------------------------------------------------- -/

/-! #brief Right adjoints preserve all limits.
-/
definition Adj.right.PresLimit
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C}
    (adj : Adj L R)
    {X : Cat.{ℓobjx ℓhomx}} (F : Fun X D)
    : PresLimit F R
:= PresLimit.show
     (λ F_HasLimit c hom ω
      , adj^.right_adj
         (@limit.univ _ _ F F_HasLimit
           { obj := L^.obj c
           , hom := λ x, adj^.left_adj (hom x)
           , comm := λ x₁ x₂ f, begin rw ω f, exact sorry end
           }))
     (λ F_HasLimit c hom ωcomm x, sorry)
     (λ F_HasLimit c hom ωcomm h ω, sorry)

/-! #brief Left adjoints preserve all co-limits.
-/
definition Adj.left.PresCoLimit
    {C : Cat.{ℓobj₁ ℓhom₁}} {D : Cat.{ℓobj₂ ℓhom₂}}
    {L : Fun C D} {R : Fun D C}
    (adj : Adj L R)
    {X : Cat.{ℓobjx ℓhomx}} (F : Fun X C)
    : PresCoLimit F L
:= PresCoLimit.show
     (λ F_HasLimit c hom ω
      , adj^.left_adj
         (@colimit.univ _ _ F F_HasLimit
           { obj := R^.obj c
           , hom := λ x, adj^.right_adj (hom x)
           , comm := λ x₁ x₂ f, begin rw ω f, exact sorry end
           }))
     (λ F_HasLimit c hom ωcomm x, sorry)
     (λ F_HasLimit c hom ωcomm h ω, sorry)

end qp


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

universes u_1

namespace Mathlib

/-!
# Convergence of `p`-series

In this file we prove that the series `∑' k in ℕ, 1 / k ^ p` converges if and only if `p > 1`.
The proof is based on the
[Cauchy condensation test](https://en.wikipedia.org/wiki/Cauchy_condensation_test): `∑ k, f k`
converges if and only if so does `∑ k, 2 ^ k f (2 ^ k)`. We prove this test in
`nnreal.summable_condensed_iff` and `summable_condensed_iff_of_nonneg`, then use it to prove
`summable_one_div_rpow`. After this transformation, a `p`-series turns into a geometric series.

## TODO

It should be easy to generalize arguments to Schlömilch's generalization of the Cauchy condensation
test once we need it.

## Tags

p-series, Cauchy condensation test
-/

/-!
### Cauchy condensation test

In this section we prove the Cauchy condensation test: for `f : ℕ → ℝ≥0` or `f : ℕ → ℝ`,
`∑ k, f k` converges if and only if so does `∑ k, 2 ^ k f (2 ^ k)`. Instead of giving a monolithic
proof, we split it into a series of lemmas with explicit estimates of partial sums of each series in
terms of the partial sums of the other series.
-/

namespace finset

theorem le_sum_condensed' {M : Type u_1} [ordered_add_comm_monoid M] {f : ℕ → M}
    (hf : ∀ {m n : ℕ}, 0 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (finset.sum (Ico 1 (bit0 1 ^ n)) fun (k : ℕ) => f k) ≤
        finset.sum (range n) fun (k : ℕ) => bit0 1 ^ k •ℕ f (bit0 1 ^ k) :=
  sorry

theorem le_sum_condensed {M : Type u_1} [ordered_add_comm_monoid M] {f : ℕ → M}
    (hf : ∀ {m n : ℕ}, 0 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (finset.sum (range (bit0 1 ^ n)) fun (k : ℕ) => f k) ≤
        f 0 + finset.sum (range n) fun (k : ℕ) => bit0 1 ^ k •ℕ f (bit0 1 ^ k) :=
  sorry

theorem sum_condensed_le' {M : Type u_1} [ordered_add_comm_monoid M] {f : ℕ → M}
    (hf : ∀ {m n : ℕ}, 1 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (finset.sum (range n) fun (k : ℕ) => bit0 1 ^ k •ℕ f (bit0 1 ^ (k + 1))) ≤
        finset.sum (Ico (bit0 1) (bit0 1 ^ n + 1)) fun (k : ℕ) => f k :=
  sorry

theorem sum_condensed_le {M : Type u_1} [ordered_add_comm_monoid M] {f : ℕ → M}
    (hf : ∀ {m n : ℕ}, 1 < m → m ≤ n → f n ≤ f m) (n : ℕ) :
    (finset.sum (range (n + 1)) fun (k : ℕ) => bit0 1 ^ k •ℕ f (bit0 1 ^ k)) ≤
        f 1 + bit0 1 •ℕ finset.sum (Ico (bit0 1) (bit0 1 ^ n + 1)) fun (k : ℕ) => f k :=
  sorry

end finset

namespace ennreal

theorem le_tsum_condensed {f : ℕ → ennreal} (hf : ∀ {m n : ℕ}, 0 < m → m ≤ n → f n ≤ f m) :
    (tsum fun (k : ℕ) => f k) ≤ f 0 + tsum fun (k : ℕ) => bit0 1 ^ k * f (bit0 1 ^ k) :=
  sorry

theorem tsum_condensed_le {f : ℕ → ennreal} (hf : ∀ {m n : ℕ}, 1 < m → m ≤ n → f n ≤ f m) :
    (tsum fun (k : ℕ) => bit0 1 ^ k * f (bit0 1 ^ k)) ≤ f 1 + bit0 1 * tsum fun (k : ℕ) => f k :=
  sorry

end ennreal

namespace nnreal

/-- Cauchy condensation test for a series of `nnreal` version. -/
theorem summable_condensed_iff {f : ℕ → nnreal} (hf : ∀ {m n : ℕ}, 0 < m → m ≤ n → f n ≤ f m) :
    (summable fun (k : ℕ) => bit0 1 ^ k * f (bit0 1 ^ k)) ↔ summable f :=
  sorry

end nnreal

/-- Cauchy condensation test for series of nonnegative real numbers. -/
theorem summable_condensed_iff_of_nonneg {f : ℕ → ℝ} (h_nonneg : ∀ (n : ℕ), 0 ≤ f n)
    (h_mono : ∀ {m n : ℕ}, 0 < m → m ≤ n → f n ≤ f m) :
    (summable fun (k : ℕ) => bit0 1 ^ k * f (bit0 1 ^ k)) ↔ summable f :=
  sorry

/-!
### Convergence of the `p`-series

In this section we prove that for a real number `p`, the series `∑' n : ℕ, 1 / (n ^ p)` converges if
and only if `1 < p`. There are many different proofs of this fact. The proof in this file uses the
Cauchy condensation test we formalized above. This test implies that `∑ n, 1 / (n ^ p)` converges if
and only if `∑ n, 2 ^ n / ((2 ^ n) ^ p)` converges, and the latter series is a geometric series with
common ratio `2 ^ {1 - p}`. -/

/-- Test for congergence of the `p`-series: the real-valued series `∑' n : ℕ, (n ^ p)⁻¹` converges
if and only if `1 < p`. -/
@[simp] theorem real.summable_nat_rpow_inv {p : ℝ} : (summable fun (n : ℕ) => ↑n ^ p⁻¹) ↔ 1 < p :=
  sorry

/-- Test for congergence of the `p`-series: the real-valued series `∑' n : ℕ, 1 / n ^ p` converges
if and only if `1 < p`. -/
theorem real.summable_one_div_nat_rpow {p : ℝ} : (summable fun (n : ℕ) => 1 / ↑n ^ p) ↔ 1 < p :=
  sorry

/-- Test for congergence of the `p`-series: the real-valued series `∑' n : ℕ, (n ^ p)⁻¹` converges
if and only if `1 < p`. -/
@[simp] theorem real.summable_nat_pow_inv {p : ℕ} : (summable fun (n : ℕ) => ↑n ^ p⁻¹) ↔ 1 < p :=
  sorry

/-- Test for congergence of the `p`-series: the real-valued series `∑' n : ℕ, 1 / n ^ p` converges
if and only if `1 < p`. -/
theorem real.summable_one_div_nat_pow {p : ℕ} : (summable fun (n : ℕ) => 1 / ↑n ^ p) ↔ 1 < p :=
  sorry

/-- Harmonic series is not unconditionally summable. -/
theorem real.not_summable_nat_cast_inv : ¬summable fun (n : ℕ) => ↑n⁻¹ := sorry

/-- Harmonic series is not unconditionally summable. -/
theorem real.not_summable_one_div_nat_cast : ¬summable fun (n : ℕ) => 1 / ↑n := sorry

/-- Harmonic series diverges. -/
theorem real.tendsto_sum_range_one_div_nat_succ_at_top :
    filter.tendsto (fun (n : ℕ) => finset.sum (finset.range n) fun (i : ℕ) => 1 / (↑i + 1))
        filter.at_top filter.at_top :=
  sorry

@[simp] theorem nnreal.summable_one_rpow_inv {p : ℝ} : (summable fun (n : ℕ) => ↑n ^ p⁻¹) ↔ 1 < p :=
  sorry

theorem nnreal.summable_one_div_rpow {p : ℝ} : (summable fun (n : ℕ) => 1 / ↑n ^ p) ↔ 1 < p := sorry

end Mathlib


import Mathlib.Tactic.ModCases

example (n : ℤ) : 3 ∣ n ^ 3 - n := by
  mod_cases n % 3
  · guard_hyp H :ₛ n ≡ 0 [ZMOD 3]; guard_target = 3 ∣ n ^ 3 - n; sorry
  · guard_hyp H :ₛ n ≡ 1 [ZMOD 3]; guard_target = 3 ∣ n ^ 3 - n; sorry
  · guard_hyp H :ₛ n ≡ 2 [ZMOD 3]; guard_target = 3 ∣ n ^ 3 - n; sorry

-- test case for https://github.com/leanprover-community/mathlib4/issues/1851
example (n : ℕ) (z : ℤ) : n = n := by
  induction n with
  | zero => rfl
  | succ n ih =>
     mod_cases h : z % 2
     · sorry
     · sorry


variable {α : Type*}

def is_prefix (l₁ : list α) (l₂ : list α) : Prop :=
∃ t, l₁ ++ t = l₂

instance list_has_le : has_le (list α) := ⟨is_prefix⟩

theorem list.is_prefix_refl (l : list α) : l ≤ l :=
⟨[], by simp⟩


import analysis.inner_product_space.dual

import to_mathlib.analysis.inner_product_space.projection

open_locale real_inner_product_space
open submodule inner_product_space linear_map (ker)

variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] [complete_space E]

-- ignore the next line which is fixing a pretty-printer bug
local notation (name := line_printing_only) `Δ` v:55 := submodule.span ℝ {v}
local notation `Δ` v:55 := submodule.span ℝ ({v} : set E)
-- ignore the next line which is fixing a pretty-printer bug
local notation (name := module_span_printing_only) `{.` x `}ᗮ` := (submodule.span ℝ {x})ᗮ
local notation `{.` x `}ᗮ` := (submodule.span ℝ ({x} : set E))ᗮ
local notation `pr[`x`]ᗮ` := orthogonal_projection (submodule.span ℝ {x})ᗮ

lemma orthogonal_span_to_dual_symm (π : E →L[ℝ] ℝ) :
  {.(inner_product_space.to_dual ℝ E).symm π}ᗮ = ker π :=
begin
  ext x,
  suffices : (∀ (a : ℝ), ⟪a • ((to_dual ℝ E).symm) π, x⟫ = 0) ↔ π x = 0,
  { simp only [orthogonal, mem_mk, set.mem_set_of_eq, linear_map.mem_ker, ← to_dual_symm_apply],
    simpa only [mem_span_singleton, forall_exists_index, forall_apply_eq_imp_iff', to_dual_symm_apply]},

  split,
  { intros h,
    simpa using h 1 },
  { intros h a,
    rw inner_smul_left,
    simp [h] }
end


import flt_three.flt_three
import algebra.gcd_monoid.finset
import field_theory.finite.basic
import algebra.gcd_monoid.div
import number_theory.regular_primes

open int finset

namespace flt_regular

namespace may_assume

lemma p_ne_three {a b c : ℤ} {n : ℕ} (hprod : a * b * c ≠ 0)
  (h : a ^ n + b ^ n = c^ n) : n ≠ 3 :=
begin
  intro hn,
  have ha : a ≠ 0 := λ ha, by simpa [ha] using hprod,
  have hb : b ≠ 0 := λ hb, by simpa [hb] using hprod,
  have hc : c ≠ 0 := λ hc, by simpa [hc] using hprod,
  simpa [hn, flt_three ha hb hc] using h
end

lemma coprime {a b c : ℤ} {n : ℕ} (H : a ^ n + b ^ n = c ^ n) (hprod : a * b * c ≠ 0) :
  let d := ({a, b, c} : finset ℤ).gcd id in
  (a / d) ^ n + (b / d) ^ n = (c / d) ^ n ∧
  ({a / d, b / d, c / d} : finset ℤ).gcd id = 1 ∧
  (a / d) * (b / d) * (c / d) ≠ 0 :=
begin
  have ha : a ≠ 0 := λ ha, by simpa [ha] using hprod,
  have hb : b ≠ 0 := λ hb, by simpa [hb] using hprod,
  have hc : c ≠ 0 := λ hc, by simpa [hc] using hprod,
  let s : finset ℤ := {a, b, c},
  set d : ℤ := s.gcd id with hddef,
  have hadiv : d ∣ a := gcd_dvd (by simp),
  have hbdiv : d ∣ b := gcd_dvd (by simp),
  have hcdiv : d ∣ c := gcd_dvd (by simp),
  have hdzero : d ≠ 0 := λ hdzero, by simpa [ha] using finset.gcd_eq_zero_iff.1 hdzero a (by simp),
  have hdp : d ^ n ≠ 0 := λ hdn, hdzero (pow_eq_zero hdn),

  refine ⟨_, _, λ habs, _⟩,
  { obtain ⟨na, hna⟩ := hadiv, obtain ⟨nb, hnb⟩ := hbdiv, obtain ⟨nc, hnc⟩ := hcdiv,
    rw [← hddef],
    simpa [hna, hnb, hnc, mul_pow, hdzero, int.add_mul_div_left (d ^ n * na ^ n) (nb ^ n), hdp]
      using congr_arg (/ d ^ n) H },
  { simpa [gcd_eq_gcd_image] using
      finset.int.gcd_div_id_eq_one (show a ∈ ({a, b, c} : finset ℤ), by simp) ha },
  { simp only [mul_eq_zero] at habs,
    rcases habs with (Ha | Hb) | Hc,
    { exact ha (int.eq_zero_of_div_eq_zero (by exact gcd_dvd (by simp)) Ha) },
    { exact hb (int.eq_zero_of_div_eq_zero (by exact gcd_dvd (by simp)) Hb) },
    { exact hc (int.eq_zero_of_div_eq_zero (by exact gcd_dvd (by simp)) Hc) } }
end

end may_assume

lemma p_dvd_c_of_ab_of_anegc {p : ℕ} {a b c : ℤ} (hpri : p.prime) (hp : p ≠ 3)
  (h : a ^ p + b ^ p = c ^ p) (hab : a ≡ b [ZMOD p]) (hbc : b ≡ -c [ZMOD p]) : ↑p ∣ c :=
begin
  letI : fact p.prime := ⟨hpri⟩,
  replace h := congr_arg (λ (n : ℤ), (n : zmod p)) h,
  simp only [int.coe_nat_pow, int.cast_add, int.cast_pow, zmod.pow_card] at h,
  simp only [← zmod.int_coe_eq_int_coe_iff, int.cast_neg] at hbc hab,
  rw [hab, hbc, ← sub_eq_zero, ← sub_eq_add_neg, ← int.cast_neg, ← int.cast_sub,
    ← int.cast_sub] at h,
  ring_nf at h,
  simp only [int.cast_neg, int.cast_mul, int.cast_bit1, int.cast_one, int.cast_coe_nat,
    neg_eq_zero, mul_eq_zero] at h,
  rw [← zmod.int_coe_zmod_eq_zero_iff_dvd],
  refine or.resolve_left h (λ h3, _),
  rw [show (3 : zmod p) = ↑(3 : ℕ), by simp, zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.dvd_prime
    (nat.prime_three)] at h3,
  cases h3 with H₁ H₂,
  { exact hpri.ne_one H₁ },
  { exact hp H₂ }
end

lemma a_not_cong_b {p : ℕ} {a b c : ℤ} (hpri : p.prime) (hp5 : 5 ≤ p) (hprod : a * b * c ≠ 0)
  (h : a ^ p + b ^ p = c ^ p) (hgcd : ({a, b, c} : finset ℤ).gcd id = 1)
  (caseI : ¬ ↑p ∣ (a * b * c)) :
  ∃ (x y z : ℤ), x ^ p + y ^ p = z ^ p ∧
  ({x, y, z} : finset ℤ).gcd id = 1 ∧
  ¬x ≡ y [ZMOD p] ∧
  x * y * z ≠ 0 ∧
  ¬ ↑p ∣ x * y * z :=
begin
  by_cases H : a ≡ b [ZMOD p],
  swap,
  { exact ⟨a, b, c, ⟨h, hgcd, H, hprod, caseI⟩⟩ },
  refine ⟨a, -c, -b, ⟨_, _, λ habs, _, _, _⟩⟩,
  { have hpodd : p ≠ 2 := by linarith,
    simp only [neg_pow, (or.resolve_left hpri.eq_two_or_odd' hpodd).neg_one_pow, neg_one_mul,
      ← sub_eq_add_neg, sub_eq_iff_eq_add],
    symmetry,
    rw [neg_add_eq_iff_eq_add, add_comm],
    exact h.symm },
  { convert hgcd using 1,
    have : ({a, -c, -b} : finset ℤ) = {a, -b, -c},
    { refine finset.ext (λ x, ⟨λ hx, _, λ hx, _⟩);
      { simp only [mem_insert, mem_singleton] at hx,
        rcases hx with (H | H | H);
        simp [H] } },
    rw [this],
    simp only [gcd_insert, id.def, gcd_singleton, normalize_apply, neg_mul],
    congr' 1,
    rw [← coe_gcd, ← coe_gcd, int.gcd_eq_nat_abs, int.gcd_eq_nat_abs],
    simp only [nat_abs_neg, nat.cast_inj],
    rcases ⟨int.is_unit_iff.1 (norm_unit (-c)).is_unit,
      int.is_unit_iff.1 (norm_unit c).is_unit⟩ with ⟨H₁ | H₂, H₃ | H₄⟩,
    { simp [H₁, H₃] },
    { simp [H₁, H₄] },
    { simp [H₂, H₃] },
    { simp [H₂, H₄] } },
  { have hp3 : p ≠ 3 := by linarith,
    rw [← zmod.int_coe_eq_int_coe_iff] at habs H,
    rw [H] at habs,
    rw [zmod.int_coe_eq_int_coe_iff] at habs H,
    obtain ⟨n, hn⟩ := p_dvd_c_of_ab_of_anegc hpri hp3 h H habs,
    refine caseI ⟨a * b * n, _⟩,
    rw [hn],
    ring },
  { convert hprod using 1,
    ring },
  { ring_nf at ⊢ caseI,
    exact caseI }
end

end flt_regular


import UnitConjecture.FreeModule
import Mathlib.Algebra.Field.Basic

/-!
# Group Rings

We construct the Group ring `R[G]` given a group `G` and a ring `R`, both having decidable equality. The ring structures is constructed using the (implicit) universal property of `R`-modules. As a check on our definitions, `R[G]` is proved to be a Ring.

We first define multiplication on formal sums. We prove many properties that are used both to show invariance under elementary moves and to prove that `R[G]` is a ring.

-/

variable {R : Type} [Ring R] [DecidableEq R]

variable {G: Type} [Group G] [DecidableEq G]

/-!
## Multiplication on formal sums
-/
section FormalSumMul

/-- multiplication by a monomial -/
def FormalSum.mulMonom (b: R)(h: G) : FormalSum R G → FormalSum R G
| [] => []
| (a, g) :: tail => (a * b, g * h) :: (mulMonom b h tail)

/-- multiplication for formal sums -/
def FormalSum.mul(fst: FormalSum R G) : FormalSum R G → FormalSum R G
| [] =>    []
| (b, h) :: ys =>
  (FormalSum.mulMonom  b h fst) ++ (mul fst ys)
end FormalSumMul

/-!

## Properties of multiplication on formal sums
-/
namespace GroupRing

open FormalSum
/-- multiplication by the zero monomial -/
theorem mul_monom_zero (g x₀: G)(s: FormalSum R G): coords (mulMonom 0 g s) x₀ = 0 := by
  induction s with
  | nil =>
    simp [mulMonom, coords]
  | cons h t ih =>
    simp [mulMonom, coords, monom_coords_at_zero]
    assumption

/-- distributivity of multiplication by a monomial -/
theorem mul_monom_dist(b : R)(h x₀ : G)(s₁ s₂: FormalSum R G): coords (mulMonom b h (s₁  ++ s₂)) x₀ = coords (mulMonom b h s₁) x₀ + coords (mulMonom b h s₂) x₀ := by
    induction s₁ with
    | nil =>
      simp [mulMonom, coords]
    | cons head tail ih =>
      simp [mulMonom, coords]
      rw [ih]
      simp [add_assoc]

/-- right distributivity -/
theorem mul_dist(x₀ : G)(s₁ s₂ s₃: FormalSum R G): coords (mul s₁ (s₂  ++ s₃)) x₀ = coords (mul s₁ s₂) x₀ + coords (mul s₁ s₃) x₀ := by
    induction s₂ with
    | nil =>
      simp [mulMonom, coords]
    | cons head tail ih =>
      simp [mulMonom, coords, mul]
      rw [← append_coords]
      rw [← append_coords]
      rw [ih]
      simp [add_assoc]

/-- associativity with two terms monomials -/
theorem mul_monom_monom_assoc(a b : R)(h x₀ : G)(s : FormalSum R G): coords (mulMonom b h (mulMonom a x s)) x₀ =
    coords (mulMonom (a * b) (x * h) s) x₀  := by
    induction s with
    | nil =>
      simp [mulMonom, coords]
    | cons head tail ih =>
      let (a₁, x₁) := head
      simp [mulMonom, coords, mul_assoc]
      rw [ih]

/-- associativity with one term a monomial -/
theorem mul_monom_assoc(b : R)(h x₀ : G)(s₁ s₂: FormalSum R G): coords (mulMonom b h (mul s₁ s₂)) x₀ =
    coords (mul s₁ (mulMonom b h s₂)) x₀  := by
    induction s₂ with
    | nil =>
      simp [mulMonom, coords]
    | cons head tail ih =>
      let (a, x) := head
      simp [mulMonom, coords, mul]
      rw [← append_coords]
      simp
      rw [mul_monom_dist]
      rw [ih]
      simp [add_assoc, mulMonom]
      rw [mul_monom_monom_assoc]

/-- left distributivity for multiplication by a monomial -/
theorem mul_monom_add(b₁ b₂ : R)(h x₀ : G)(s: FormalSum R G): coords (mulMonom (b₁ + b₂) h s) x₀ = coords (mulMonom b₁ h s) x₀ + coords (mulMonom b₂ h s) x₀ := by
  induction s with
  | nil =>
  simp [mulMonom, coords]
  | cons head tail ih =>
    let (a, g) := head
    simp [mulMonom, coords]
    rw [left_distrib]
    rw [monom_coords_hom]
    rw [ih]
    conv =>
      lhs
      rw [add_assoc]
      arg 2
      rw [← add_assoc]
      congr
      rw [add_comm]
    conv =>
      rhs
      rw [add_assoc]
    conv =>
      rhs
      arg 2
      skip
      rw [← add_assoc]

/-- multiplication equivalent when adding term with `0` coefficient -/
theorem mul_zero_cons (s t : FormalSum R G) :  mul s ((0, h) :: t) ≈  mul s t := by
    induction s
    case nil =>
      simp [mul, mulMonom]
      apply eqlCoords.refl
    case cons head tail _ =>
      simp [mul, mulMonom]
      apply funext ; intro x₀
      simp [coords]
      rw [monom_coords_at_zero]
      rw [zero_add]
      rw [← append_coords]
      simp [coords, mul]
      let l := mul_monom_zero h x₀ tail
      rw [l]

/-!
## Induced product on the quotient
-/

/-- Quotient in second argument for group ring multiplication
-/
def mulAux : FormalSum R G → R[G] → R[G] := by
  intro s
  apply  Quotient.lift (⟦FormalSum.mul s ·⟧)
  apply func_eql_of_move_equiv
  intro t t' rel
  simp
  induction rel with
  | zeroCoeff tail g a hyp =>
    rw [hyp]
    dsimp [mul]
    apply funext
    intro x₀
    rw [← append_coords]
    let l := mul_monom_zero g x₀ s
    rw [l]
    simp [zero_add]
  | addCoeffs a b x tail =>
    apply funext; intro x₀
    simp [mul]
    repeat (rw [← append_coords])
    simp
    simp [mul_monom_add, add_assoc]
  | cons a x s₁ s₂ _ step =>
    apply funext ; intro x₀
    simp [mul]
    rw [← append_coords]
    rw [← append_coords]
    simp
    let l := congrFun step x₀
    rw [l]
  | swap a₁ a₂ x₁ x₂ tail =>
    apply funext ; intro x₀
    simp [mul, ← append_coords]
    rw [← add_assoc]
    rw [← add_assoc]
    simp
    let lc :=
      add_comm
        (coords (mulMonom a₁ x₁ s) x₀)
        (coords (mulMonom a₂ x₂ s) x₀)
    rw [lc]

open ElementaryMove
/-- invariance under moves of multiplication by monomials -/
theorem mul_monom_invariant (b : R)(h x₀ : G)(s₁ s₂ : FormalSum R G) (rel : ElementaryMove R G s₁ s₂) : coords (mulMonom b h s₁) x₀ = coords (mulMonom b h s₂) x₀ := by
      induction rel with
      | zeroCoeff tail g a hyp =>
        rw [hyp]
        simp [mulMonom, coords,monom_coords_at_zero]
      | addCoeffs a₁ a₂ x tail =>
        simp [mulMonom, coords, right_distrib, monom_coords_hom, add_assoc]

      | cons a x t₁ t₂ _ step =>
        simp [mulMonom, coords, step]
      | swap a₁ a₂ x₁ x₂ tail =>
        simp [mulMonom, coords]
        conv =>
          lhs
          rw [← add_assoc]
          arg 1
          rw [add_comm]
        rw [← add_assoc]

/-- invariance under moves for the first argument for multipilication -/
theorem first_arg_invariant (s₁ s₂ t : FormalSum R G) (rel : ElementaryMove R G s₁ s₂) : FormalSum.mul s₁ t ≈  FormalSum.mul s₂ t := by
    cases t
    case nil =>
      simp [mul]
      rfl
    case cons head' tail' =>
      let (b, h) := head'
      induction rel with
      | zeroCoeff tail g a hyp =>
        rw [hyp]
        simp [mul, mulMonom]
        apply funext; intro x₀
        rw [← append_coords]
        simp
        simp [coords, monom_coords_at_zero]
        rw [← append_coords]
        simp
        let rel' : ElementaryMove R G ((0, g) :: tail)  tail := by
          apply ElementaryMove.zeroCoeff
          rfl
        let prev  := first_arg_invariant  _ _ tail' rel'
        let pl := congrFun prev x₀
        rw [pl]
      | addCoeffs a₁ a₂ x tail =>
        simp [mul]
        apply funext; intro x₀
        rw [← append_coords]
        rw [← append_coords]
        simp [coords]
        rw [right_distrib]
        simp [monom_coords_hom]
        let rel' : ElementaryMove R G
          ((a₁, x) :: (a₂, x) :: tail)
            ((a₁ + a₂, x) :: tail) := by
            apply ElementaryMove.addCoeffs
        let prev  := first_arg_invariant  _ _ tail' rel'
        let pl := congrFun prev x₀
        rw [pl]
        simp [add_assoc]
      | cons a x s₁ s₂ r _ =>
        simp [mul]
        apply funext; intro x₀
        rw [← append_coords]
        rw [← append_coords]
        simp [coords]
        let rel' : ElementaryMove R G
          ((a, x) :: s₁)
            ((a, x) :: s₂) := by
            apply ElementaryMove.cons
            assumption
        let prev  := first_arg_invariant  _ _ tail' rel'
        let pl := congrFun prev x₀
        rw [pl]
        let ps := mul_monom_invariant b h x₀ s₁ s₂ r
        rw [ps]
      | swap a₁ a₂ x₁ x₂ tail =>
        simp [mul]
        apply funext; intro x₀
        rw [← append_coords]
        rw [← append_coords]
        simp
        rw [mulMonom]
        rw [mulMonom]
        rw [coords]
        rw [coords]
        rw [mulMonom]
        rw [mulMonom]
        rw [coords]
        rw [coords]
        simp
        let rel' : ElementaryMove R G
          ((a₁, x₁) :: (a₂, x₂) :: tail)
            ((a₂, x₂) :: (a₁, x₁) :: tail) := by
            apply ElementaryMove.swap
        let prev  := first_arg_invariant  _ _ tail' rel'
        let pl := congrFun prev x₀
        rw [pl]
        simp
        rw [← add_assoc]
        rw [← add_assoc]
        simp
        conv =>
          lhs
          rw [add_comm]

/-- multiplication for free modules -/
def mul : R[G] → R[G] → R[G] := by
  let f  := fun (s : FormalSum R G) =>
    fun  (t : R[G]) => mulAux  s t
  apply  Quotient.lift f
  apply func_eql_of_move_equiv
  intro s₁ s₂ rel
  simp
  apply funext
  apply Quotient.ind
  intro t
  let lhs : mulAux s₁ (Quotient.mk (formalSumSetoid R G) t) =
    ⟦FormalSum.mul s₁ t⟧ := by rfl
  let rhs : mulAux s₂ (Quotient.mk (formalSumSetoid R G) t) =
    ⟦FormalSum.mul s₂ t⟧ := by rfl
  rw [lhs, rhs]
  simp
  apply first_arg_invariant
  exact rel

/-!
## The Ring Structure
-/

instance groupRingMul : Mul (R[G]) :=
  ⟨mul⟩

instance : One (R[G]) :=
  ⟨⟦[(1, 1)]⟧⟩

instance : AddCommGroup (R[G]) :=
  {
    zero := ⟦ [] ⟧
    add := FreeModule.add

    add_assoc := FreeModule.addn_assoc
    add_zero := FreeModule.addn_zero
    zero_add := FreeModule.zero_addn
    add_comm := FreeModule.addn_comm
    add_left_neg := by
        intro x
        let l := FreeModule.coeffs_distrib (-1 : R) (1 : R) x
        rw [add_left_neg, FreeModule.unit_coeffs, FreeModule.zero_coeffs] at l
        exact l
  }

/-- The group ring is a ring -/
instance : Ring (R[G]) :=
  {
    mul := mul
    neg := fun x => (-1 : R) • x

    sub_eq_add_neg := by
      intro x y
      rfl

    add_left_neg := by
        intro x
        let l := FreeModule.coeffs_distrib (-1 : R) (1 : R) x
        simp at l
        have lc : (-1 : R) + 1 = 0 := by
            apply add_left_neg
        -- rw [lc] at l
        rw [FreeModule.unit_coeffs] at l
        rw [FreeModule.zero_coeffs] at l
        exact l

    left_distrib := by
      apply @Quotient.ind (motive := fun a  =>
        ∀ b c, a * (b + c) = a * b + a * c)
      intro x
      apply @Quotient.ind₂ (motive := fun b c =>
        ⟦ x ⟧ * (b + c) = ⟦ x ⟧ * b + ⟦ x ⟧ * c)
      intro y z
      apply Quotient.sound
      induction y with
      | nil =>
          simp
          simp [FormalSum.mul]
          apply eqlCoords.refl
      | cons h t ih =>
          simp [FormalSum.mul]
          apply funext; intro x₀
          repeat (rw [← append_coords])
          simp
          let lih := congrFun ih x₀
          rw [← append_coords] at lih
          rw [lih]
    right_distrib := by
      apply @Quotient.ind (motive := fun a  =>
        ∀ b c, (a + b) * c = a * c + b * c)
      intro x
      apply @Quotient.ind₂ (motive := fun b c =>
        (⟦ x ⟧ + b) * c = ⟦ x ⟧ * c + b * c)
      intro y z
      apply Quotient.sound
      induction z with
      | nil =>
          simp [FormalSum.mul]
          apply eqlCoords.refl
      | cons h t ih =>
          let (a, h) := h
          simp [FormalSum.mul, mulMonom]
          funext x₀
          repeat (rw [← append_coords])
          simp
          let lih := congrFun ih x₀
          rw [← append_coords] at lih
          rw [lih]
          simp only [add_assoc]
          rw [mul_monom_dist]
          simp only [add_assoc, add_left_comm, add_left_cancel_iff]
    zero_mul := by
      apply Quotient.ind
      intro x
      apply Quotient.sound
      induction x with
      | nil =>
        rfl
      | cons h t ih =>
        rw [FormalSum.mul]
        simp
        apply funext ; intro x₀
        let lih := congrFun ih x₀
        rw [coords] at lih
        rw [← append_coords]
        rw [lih]
        simp
        rw [mulMonom]

    mul_zero := by
      apply Quotient.ind
      intro x
      rfl

    one := ⟦[(1, 1)]⟧
    natCast := fun n => ⟦ [(n, 1)] ⟧
    natCast_zero :=
      by
      apply Quotient.sound
      apply funext; intro x₀
      simp [coords, monomCoeff]
      cases 1 == x₀ <;> rfl
    natCast_succ := by
      intro n
      apply Quotient.sound
      apply funext; intro x₀
      rw [← append_coords]
      simp
      cases m:1 == x₀ with
      | true => simp only [coords, monomCoeff, m, add_zero]
      | false => simp only [coords, monomCoeff, m, add_zero]
    mul_assoc := by
      apply @Quotient.ind (motive := fun a  =>
        ∀ b c, a * b * c = a * (b * c))
      intro x
      apply @Quotient.ind₂ (motive := fun b c =>
        ⟦ x ⟧ * b * c = ⟦ x ⟧ * (b  * c))
      intro y z
      apply Quotient.sound
      apply funext; intro x₀
      simp [coords]
      induction z with
      | nil =>
          simp
          simp [FormalSum.mul]
      | cons h t ih =>
          let (a, h) := h
          simp [FormalSum.mul, mulMonom]
          repeat (rw [← append_coords])
          rw [mul_dist]
          rw [ih]
          rw [mul_monom_assoc]
    mul_one := by
      apply Quotient.ind
      intro x
      apply Quotient.sound
      apply funext; intro x₀
      repeat (rw[FormalSum.mul])
      simp
      induction x with
      | nil => rfl
      | cons h t ih =>
        let (a, x) := h
        rw [mulMonom, coords, monomCoeff]
        simp
        rw [coords, monomCoeff]
        cases m:x == x₀ <;> simp [ih]

    one_mul := by
      apply Quotient.ind
      intro x
      apply Quotient.sound
      apply funext; intro x₀
      induction x with
      | nil => rfl
      | cons h t ih =>
        let (a, x) := h
        repeat (rw [coords])
        simp
        rw [FormalSum.mul]
        rw [← append_coords]
        simp [ih, mulMonom, coords]
  }

end GroupRing

/-!
## Inclusions of the group and ring into the group ring
-/
set_option autoImplicit false

/-- Product `R → G → R[G]`, `r ↦ g ↦ r ⬝ g`; used only in verification results -/
instance groupRingMul {R G : Type _} [Ring R] [Group G] [DecidableEq G]
 : HMul R G (FreeModule R G) := ⟨fun r g ↦ ⟦[(r, g)]⟧⟩

/-- Monoid homomorphism from `G` to `R[G]` given by `g ↦ 1 ⬝ g` -/
def groupInclusionHom  (G : Type) [Group G] [DecidableEq G] : G →* R[G] :=
  { toFun := baseInclusion 1,
    map_one' := rfl,
    map_mul' :=
    by
      intro _ _
      apply Quotient.sound
      funext x
      simp [FormalSum.coords]
  }

/-- As a function `groupInclusionHom` is `g ↦ 1 ⬝ g`-/
theorem groupInclusionHom_formula (G : Type) [Group G] [DecidableEq G] :
  (groupInclusionHom (R := R) G).toFun =
    fun g : G ↦ (1 : R) * g := rfl

/-- The monoid homomorphism `G → R[G]`, `g ↦ 1 ⬝ g` is injective if `1 ≠ 0` in `R`  -/
theorem groupInclusionHom_injective'   (hR : (1 : R) ≠ (0 : R)) : Function.Injective (groupInclusionHom (R := R) G) := by
  intro _ _
  apply baseInclusion_injective (1 : R) hR (X := G)

/-- For a field `F` the monoid homomorphism `G → F[G]`, `g ↦ 1 ⬝ g` is injective. -/
theorem groupInclusionHom_injective {F : Type} [Field F] [DecidableEq F] (G : Type) [Group G][DecidableEq G] : Function.Injective (groupInclusionHom (R := F) G) := by
  intro _ _
  apply groupInclusionHom_injective'
  have : (0 : F) ≠ (1 : F) := zero_ne_one
  simp_all only [ne_eq, zero_ne_one, not_false_iff, one_ne_zero]

/-- The ring homomorphism `R → R[G]` given by `a ↦  a ⬝ 1`-/
def ringInclusionHom  (G : Type) [Group G] [DecidableEq G] : R →+* R[G] :=
  { toFun := coeffInclusion 1,
    map_one' := rfl,
    map_mul' :=
    by
      intro _ _
      apply Quotient.sound
      funext x
      simp [FormalSum.coords],
    map_zero' := by
      apply Quotient.sound
      funext x
      simp [FormalSum.coords, monomCoeff, add_zero]
      split <;> rfl,
    map_add' := by
      intro _ _
      apply Quotient.sound
      funext x
      simp only [FormalSum.coords, monomCoeff]
      split <;> simp only [add_zero]
  }

/-- As a function, `ringInclusionHom` is `r ↦ r ⬝ 1` -/
theorem ringInclusionHom_formula (G : Type) [Group G] [DecidableEq G] :
  (ringInclusionHom (R := R) G).toFun =
    fun r : R ↦ r * (1 : G) := rfl

/-- The ring homomorphism `R → R[G]` given by `a ↦  a ⬝ 1` is injective -/
theorem ringInclusionHom_injective'
  (G : Type) [Group G] [DecidableEq G] : Function.Injective (ringInclusionHom (R := R) G) := by
  intro _ _
  apply coeffInclusion_injective


/-
Copyright (c) 2019 Jan-David Salchow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jan-David Salchow, Sébastien Gouëzel, Jean Lo

! This file was ported from Lean 3 source module analysis.normed_space.continuous_linear_map
! leanprover-community/mathlib commit e0e2f10d64d8a5fd11140de398eaa1322eb46c07
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Basic

/-! # Constructions of continuous linear maps between (semi-)normed spaces

A fundamental fact about (semi-)linear maps between normed spaces over sensible fields is that
continuity and boundedness are equivalent conditions.  That is, for normed spaces `E`, `F`, a
`linear_map` `f : E →ₛₗ[σ] F` is the coercion of some `continuous_linear_map` `f' : E →SL[σ] F`, if
and only if there exists a bound `C` such that for all `x`, `‖f x‖ ≤ C * ‖x‖`.

We prove one direction in this file: `linear_map.mk_continuous`, boundedness implies continuity. The
other direction, `continuous_linear_map.bound`, is deferred to a later file, where the
strong operator topology on `E →SL[σ] F` is available, because it is natural to use
`continuous_linear_map.bound` to define a norm `⨆ x, ‖f x‖ / ‖x‖` on `E →SL[σ] F` and to show that
this is compatible with the strong operator topology.

This file also contains several corollaries of `linear_map.mk_continuous`: other "easy"
constructions of continuous linear maps between normed spaces.

This file is meant to be lightweight (it is imported by much of the analysis library); think twice
before adding imports!
-/

open Metric ContinuousLinearMap

open Set Real

open NNReal

variable {𝕜 𝕜₂ E F G : Type _}

variable [NormedField 𝕜] [NormedField 𝕜₂]

/-! # General constructions -/

section Seminormed

variable [SeminormedAddCommGroup E] [SeminormedAddCommGroup F] [SeminormedAddCommGroup G]

variable [NormedSpace 𝕜 E] [NormedSpace 𝕜₂ F] [NormedSpace 𝕜 G]

variable {σ : 𝕜 →+* 𝕜₂} (f : E →ₛₗ[σ] F)

/-- Construct a continuous linear map from a linear map and a bound on this linear map.
The fact that the norm of the continuous linear map is then controlled is given in
`linear_map.mk_continuous_norm_le`. -/
def LinearMap.mkContinuous (C : ℝ) (h : ∀ x, ‖f x‖ ≤ C * ‖x‖) : E →SL[σ] F :=
  ⟨f, AddMonoidHomClass.continuous_of_bound f C h⟩
#align linear_map.mk_continuous LinearMap.mkContinuous

/-- Reinterpret a linear map `𝕜 →ₗ[𝕜] E` as a continuous linear map. This construction
is generalized to the case of any finite dimensional domain
in `linear_map.to_continuous_linear_map`. -/
def LinearMap.toContinuousLinearMap₁ (f : 𝕜 →ₗ[𝕜] E) : 𝕜 →L[𝕜] E :=
  f.mkContinuous ‖f 1‖ fun x =>
    le_of_eq <| by
      conv_lhs => rw [← mul_one x]
      rw [← smul_eq_mul, f.map_smul, norm_smul, mul_comm]
#align linear_map.to_continuous_linear_map₁ LinearMap.toContinuousLinearMap₁

/-- Construct a continuous linear map from a linear map and the existence of a bound on this linear
map. If you have an explicit bound, use `linear_map.mk_continuous` instead, as a norm estimate will
follow automatically in `linear_map.mk_continuous_norm_le`. -/
def LinearMap.mkContinuousOfExistsBound (h : ∃ C, ∀ x, ‖f x‖ ≤ C * ‖x‖) : E →SL[σ] F :=
  ⟨f,
    let ⟨C, hC⟩ := h
    AddMonoidHomClass.continuous_of_bound f C hC⟩
#align linear_map.mk_continuous_of_exists_bound LinearMap.mkContinuousOfExistsBound

theorem continuous_of_linear_of_boundₛₗ {f : E → F} (h_add : ∀ x y, f (x + y) = f x + f y)
    (h_smul : ∀ (c : 𝕜) (x), f (c • x) = σ c • f x) {C : ℝ} (h_bound : ∀ x, ‖f x‖ ≤ C * ‖x‖) :
    Continuous f :=
  let φ : E →ₛₗ[σ] F :=
    { toFun := f
      map_add' := h_add
      map_smul' := h_smul }
  AddMonoidHomClass.continuous_of_bound φ C h_bound
#align continuous_of_linear_of_boundₛₗ continuous_of_linear_of_boundₛₗ

theorem continuous_of_linear_of_bound {f : E → G} (h_add : ∀ x y, f (x + y) = f x + f y)
    (h_smul : ∀ (c : 𝕜) (x), f (c • x) = c • f x) {C : ℝ} (h_bound : ∀ x, ‖f x‖ ≤ C * ‖x‖) :
    Continuous f :=
  let φ : E →ₗ[𝕜] G :=
    { toFun := f
      map_add' := h_add
      map_smul' := h_smul }
  AddMonoidHomClass.continuous_of_bound φ C h_bound
#align continuous_of_linear_of_bound continuous_of_linear_of_bound

@[simp, norm_cast]
theorem LinearMap.mkContinuous_coe (C : ℝ) (h : ∀ x, ‖f x‖ ≤ C * ‖x‖) :
    (f.mkContinuous C h : E →ₛₗ[σ] F) = f :=
  rfl
#align linear_map.mk_continuous_coe LinearMap.mkContinuous_coe

@[simp]
theorem LinearMap.mkContinuous_apply (C : ℝ) (h : ∀ x, ‖f x‖ ≤ C * ‖x‖) (x : E) :
    f.mkContinuous C h x = f x :=
  rfl
#align linear_map.mk_continuous_apply LinearMap.mkContinuous_apply

@[simp, norm_cast]
theorem LinearMap.mkContinuousOfExistsBound_coe (h : ∃ C, ∀ x, ‖f x‖ ≤ C * ‖x‖) :
    (f.mkContinuousOfExistsBound h : E →ₛₗ[σ] F) = f :=
  rfl
#align linear_map.mk_continuous_of_exists_bound_coe LinearMap.mkContinuousOfExistsBound_coe

@[simp]
theorem LinearMap.mkContinuousOfExistsBound_apply (h : ∃ C, ∀ x, ‖f x‖ ≤ C * ‖x‖) (x : E) :
    f.mkContinuousOfExistsBound h x = f x :=
  rfl
#align linear_map.mk_continuous_of_exists_bound_apply LinearMap.mkContinuousOfExistsBound_apply

@[simp]
theorem LinearMap.toContinuousLinearMap₁_coe (f : 𝕜 →ₗ[𝕜] E) :
    (f.toContinuousLinearMap₁ : 𝕜 →ₗ[𝕜] E) = f :=
  rfl
#align linear_map.to_continuous_linear_map₁_coe LinearMap.toContinuousLinearMap₁_coe

@[simp]
theorem LinearMap.toContinuousLinearMap₁_apply (f : 𝕜 →ₗ[𝕜] E) (x) :
    f.toContinuousLinearMap₁ x = f x :=
  rfl
#align linear_map.to_continuous_linear_map₁_apply LinearMap.toContinuousLinearMap₁_apply

namespace ContinuousLinearMap

theorem antilipschitz_of_bound (f : E →SL[σ] F) {K : ℝ≥0} (h : ∀ x, ‖x‖ ≤ K * ‖f x‖) :
    AntilipschitzWith K f :=
  AddMonoidHomClass.antilipschitz_of_bound _ h
#align continuous_linear_map.antilipschitz_of_bound ContinuousLinearMap.antilipschitz_of_bound

theorem bound_of_antilipschitz (f : E →SL[σ] F) {K : ℝ≥0} (h : AntilipschitzWith K f) (x) :
    ‖x‖ ≤ K * ‖f x‖ :=
  AddMonoidHomClass.bound_of_antilipschitz _ h x
#align continuous_linear_map.bound_of_antilipschitz ContinuousLinearMap.bound_of_antilipschitz

end ContinuousLinearMap

section

variable {σ₂₁ : 𝕜₂ →+* 𝕜} [RingHomInvPair σ σ₂₁] [RingHomInvPair σ₂₁ σ]

include σ₂₁

/-- Construct a continuous linear equivalence from a linear equivalence together with
bounds in both directions. -/
def LinearEquiv.toContinuousLinearEquivOfBounds (e : E ≃ₛₗ[σ] F) (C_to C_inv : ℝ)
    (h_to : ∀ x, ‖e x‖ ≤ C_to * ‖x‖) (h_inv : ∀ x : F, ‖e.symm x‖ ≤ C_inv * ‖x‖) : E ≃SL[σ] F
    where
  toLinearEquiv := e
  continuous_toFun := AddMonoidHomClass.continuous_of_bound e C_to h_to
  continuous_invFun := AddMonoidHomClass.continuous_of_bound e.symm C_inv h_inv
#align linear_equiv.to_continuous_linear_equiv_of_bounds LinearEquiv.toContinuousLinearEquivOfBounds

end

end Seminormed

section Normed

variable [NormedAddCommGroup E] [NormedAddCommGroup F] [NormedSpace 𝕜 E] [NormedSpace 𝕜₂ F]

variable {σ : 𝕜 →+* 𝕜₂} (f g : E →SL[σ] F) (x y z : E)

theorem ContinuousLinearMap.uniformEmbedding_of_bound {K : ℝ≥0} (hf : ∀ x, ‖x‖ ≤ K * ‖f x‖) :
    UniformEmbedding f :=
  (AddMonoidHomClass.antilipschitz_of_bound f hf).UniformEmbedding f.UniformContinuous
#align continuous_linear_map.uniform_embedding_of_bound ContinuousLinearMap.uniformEmbedding_of_bound

end Normed

/-! ## Homotheties -/

section Seminormed

variable [SeminormedAddCommGroup E] [SeminormedAddCommGroup F]

variable [NormedSpace 𝕜 E] [NormedSpace 𝕜₂ F]

variable {σ : 𝕜 →+* 𝕜₂} (f : E →ₛₗ[σ] F)

/-- A (semi-)linear map which is a homothety is a continuous linear map.
    Since the field `𝕜` need not have `ℝ` as a subfield, this theorem is not directly deducible from
    the corresponding theorem about isometries plus a theorem about scalar multiplication.  Likewise
    for the other theorems about homotheties in this file.
 -/
def ContinuousLinearMap.ofHomothety (f : E →ₛₗ[σ] F) (a : ℝ) (hf : ∀ x, ‖f x‖ = a * ‖x‖) :
    E →SL[σ] F :=
  f.mkContinuous a fun x => le_of_eq (hf x)
#align continuous_linear_map.of_homothety ContinuousLinearMap.ofHomothety

variable {σ₂₁ : 𝕜₂ →+* 𝕜} [RingHomInvPair σ σ₂₁] [RingHomInvPair σ₂₁ σ]

include σ₂₁

theorem ContinuousLinearEquiv.homothety_inverse (a : ℝ) (ha : 0 < a) (f : E ≃ₛₗ[σ] F) :
    (∀ x : E, ‖f x‖ = a * ‖x‖) → ∀ y : F, ‖f.symm y‖ = a⁻¹ * ‖y‖ :=
  by
  intro hf y
  calc
    ‖f.symm y‖ = a⁻¹ * (a * ‖f.symm y‖) := _
    _ = a⁻¹ * ‖f (f.symm y)‖ := by rw [hf]
    _ = a⁻¹ * ‖y‖ := by simp

  rw [← mul_assoc, inv_mul_cancel (ne_of_lt ha).symm, one_mul]
#align continuous_linear_equiv.homothety_inverse ContinuousLinearEquiv.homothety_inverse

/-- A linear equivalence which is a homothety is a continuous linear equivalence. -/
noncomputable def ContinuousLinearEquiv.ofHomothety (f : E ≃ₛₗ[σ] F) (a : ℝ) (ha : 0 < a)
    (hf : ∀ x, ‖f x‖ = a * ‖x‖) : E ≃SL[σ] F :=
  LinearEquiv.toContinuousLinearEquivOfBounds f a a⁻¹ (fun x => (hf x).le) fun x =>
    (ContinuousLinearEquiv.homothety_inverse a ha f hf x).le
#align continuous_linear_equiv.of_homothety ContinuousLinearEquiv.ofHomothety

end Seminormed

/-! ## The span of a single vector -/

section Seminormed

variable [SeminormedAddCommGroup E] [NormedSpace 𝕜 E]

namespace ContinuousLinearMap

variable (𝕜)

theorem toSpanSingleton_homothety (x : E) (c : 𝕜) :
    ‖LinearMap.toSpanSingleton 𝕜 E x c‖ = ‖x‖ * ‖c‖ :=
  by
  rw [mul_comm]
  exact norm_smul _ _
#align continuous_linear_map.to_span_singleton_homothety ContinuousLinearMap.toSpanSingleton_homothety

/-- Given an element `x` of a normed space `E` over a field `𝕜`, the natural continuous
    linear map from `𝕜` to `E` by taking multiples of `x`.-/
def toSpanSingleton (x : E) : 𝕜 →L[𝕜] E :=
  ofHomothety (LinearMap.toSpanSingleton 𝕜 E x) ‖x‖ (toSpanSingleton_homothety 𝕜 x)
#align continuous_linear_map.to_span_singleton ContinuousLinearMap.toSpanSingleton

theorem toSpanSingleton_apply (x : E) (r : 𝕜) : toSpanSingleton 𝕜 x r = r • x := by
  simp [to_span_singleton, of_homothety, LinearMap.toSpanSingleton]
#align continuous_linear_map.to_span_singleton_apply ContinuousLinearMap.toSpanSingleton_apply

theorem toSpanSingleton_add (x y : E) :
    toSpanSingleton 𝕜 (x + y) = toSpanSingleton 𝕜 x + toSpanSingleton 𝕜 y :=
  by
  ext1
  simp [to_span_singleton_apply]
#align continuous_linear_map.to_span_singleton_add ContinuousLinearMap.toSpanSingleton_add

theorem toSpanSingleton_smul' (𝕜') [NormedField 𝕜'] [NormedSpace 𝕜' E] [SMulCommClass 𝕜 𝕜' E]
    (c : 𝕜') (x : E) : toSpanSingleton 𝕜 (c • x) = c • toSpanSingleton 𝕜 x :=
  by
  ext1
  rw [to_span_singleton_apply, smul_apply, to_span_singleton_apply, smul_comm]
#align continuous_linear_map.to_span_singleton_smul' ContinuousLinearMap.toSpanSingleton_smul'

theorem toSpanSingleton_smul (c : 𝕜) (x : E) :
    toSpanSingleton 𝕜 (c • x) = c • toSpanSingleton 𝕜 x :=
  toSpanSingleton_smul' 𝕜 𝕜 c x
#align continuous_linear_map.to_span_singleton_smul ContinuousLinearMap.toSpanSingleton_smul

end ContinuousLinearMap

section

namespace ContinuousLinearEquiv

variable (𝕜)

theorem toSpanNonzeroSingleton_homothety (x : E) (h : x ≠ 0) (c : 𝕜) :
    ‖LinearEquiv.toSpanNonzeroSingleton 𝕜 E x h c‖ = ‖x‖ * ‖c‖ :=
  ContinuousLinearMap.toSpanSingleton_homothety _ _ _
#align continuous_linear_equiv.to_span_nonzero_singleton_homothety ContinuousLinearEquiv.toSpanNonzeroSingleton_homothety

end ContinuousLinearEquiv

end

end Seminormed

section Normed

variable [NormedAddCommGroup E] [NormedSpace 𝕜 E]

namespace ContinuousLinearEquiv

variable (𝕜)

/-- Given a nonzero element `x` of a normed space `E₁` over a field `𝕜`, the natural
    continuous linear equivalence from `E₁` to the span of `x`.-/
noncomputable def toSpanNonzeroSingleton (x : E) (h : x ≠ 0) : 𝕜 ≃L[𝕜] 𝕜 ∙ x :=
  ofHomothety (LinearEquiv.toSpanNonzeroSingleton 𝕜 E x h) ‖x‖ (norm_pos_iff.mpr h)
    (toSpanNonzeroSingleton_homothety 𝕜 x h)
#align continuous_linear_equiv.to_span_nonzero_singleton ContinuousLinearEquiv.toSpanNonzeroSingleton

/-- Given a nonzero element `x` of a normed space `E₁` over a field `𝕜`, the natural continuous
    linear map from the span of `x` to `𝕜`.-/
noncomputable def coord (x : E) (h : x ≠ 0) : (𝕜 ∙ x) →L[𝕜] 𝕜 :=
  (toSpanNonzeroSingleton 𝕜 x h).symm
#align continuous_linear_equiv.coord ContinuousLinearEquiv.coord

@[simp]
theorem coe_toSpanNonzeroSingleton_symm {x : E} (h : x ≠ 0) :
    ⇑(toSpanNonzeroSingleton 𝕜 x h).symm = coord 𝕜 x h :=
  rfl
#align continuous_linear_equiv.coe_to_span_nonzero_singleton_symm ContinuousLinearEquiv.coe_toSpanNonzeroSingleton_symm

@[simp]
theorem coord_toSpanNonzeroSingleton {x : E} (h : x ≠ 0) (c : 𝕜) :
    coord 𝕜 x h (toSpanNonzeroSingleton 𝕜 x h c) = c :=
  (toSpanNonzeroSingleton 𝕜 x h).symm_apply_apply c
#align continuous_linear_equiv.coord_to_span_nonzero_singleton ContinuousLinearEquiv.coord_toSpanNonzeroSingleton

@[simp]
theorem toSpanNonzeroSingleton_coord {x : E} (h : x ≠ 0) (y : 𝕜 ∙ x) :
    toSpanNonzeroSingleton 𝕜 x h (coord 𝕜 x h y) = y :=
  (toSpanNonzeroSingleton 𝕜 x h).apply_symm_apply y
#align continuous_linear_equiv.to_span_nonzero_singleton_coord ContinuousLinearEquiv.toSpanNonzeroSingleton_coord

@[simp]
theorem coord_self (x : E) (h : x ≠ 0) :
    (coord 𝕜 x h) (⟨x, Submodule.mem_span_singleton_self x⟩ : 𝕜 ∙ x) = 1 :=
  LinearEquiv.coord_self 𝕜 E x h
#align continuous_linear_equiv.coord_self ContinuousLinearEquiv.coord_self

end ContinuousLinearEquiv

end Normed