Theory CZH_UCAT_Limit_IT

(* Copyright 2021 (C) Mihails Milehins *)

section‹Initial and terminal objects as limits and colimits›
theory CZH_UCAT_Limit_IT
  imports 
    CZH_UCAT_Limit
    CZH_Elementary_Categories.CZH_ECAT_Comma
begin



subsection‹Initial and terminal objects as limits/colimits of an empty diagram›


subsubsection‹Definition and elementary properties›

text‹
See 
cite"noauthor_nlab_nodate"\footnote{
\url{https://ncatlab.org/nlab/show/initial+object}
}, cite"noauthor_nlab_nodate"\footnote{
\url{https://ncatlab.org/nlab/show/terminal+object}
} and Chapter X-1 in cite"mac_lane_categories_2010".
›

locale is_cat_obj_empty_terminal = is_cat_limit α cat_0  cf_0  z  
  for α  z 

syntax "_is_cat_obj_empty_terminal" :: "V  V  V  V  bool"
  ((_ :/ _ <CF.1 0CF :/ 0C ↦↦Cı _) [51, 51] 51)
syntax_consts "_is_cat_obj_empty_terminal"  is_cat_obj_empty_terminal
translations " : z <CF.1 0CF : 0C ↦↦Cα" 
  "CONST is_cat_obj_empty_terminal α  z "

locale is_cat_obj_empty_initial = is_cat_colimit α cat_0  cf_0  z  
  for α  z 

syntax "_is_cat_obj_empty_initial" :: "V  V  V  V  bool"
  ((_ :/ 0CF >CF.0 _ :/ 0C ↦↦Cı _) [51, 51] 51)
syntax_consts "_is_cat_obj_empty_initial"  is_cat_obj_empty_initial
translations " : 0CF >CF.0 z : 0C ↦↦Cα" 
  "CONST is_cat_obj_empty_initial α  z "


text‹Rules.›

lemma (in is_cat_obj_empty_terminal) 
  is_cat_obj_empty_terminal_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "z' = z" and "ℭ' = " 
  shows " : z' <CF.1 0CF : 0C ↦↦Cα'ℭ'"
  unfolding assms by (rule is_cat_obj_empty_terminal_axioms)

mk_ide rf is_cat_obj_empty_terminal_def
  |intro is_cat_obj_empty_terminalI|
  |dest is_cat_obj_empty_terminalD[dest]|
  |elim is_cat_obj_empty_terminalE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_empty_terminalD

lemma (in is_cat_obj_empty_initial) 
  is_cat_obj_empty_initial_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "z' = z" and "ℭ' = " 
  shows " : 0CF >CF.0 z' : 0C ↦↦Cα'ℭ'"
  unfolding assms by (rule is_cat_obj_empty_initial_axioms)

mk_ide rf is_cat_obj_empty_initial_def
  |intro is_cat_obj_empty_initialI|
  |dest is_cat_obj_empty_initialD[dest]|
  |elim is_cat_obj_empty_initialE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_empty_initialD


text‹Duality.›

lemma (in is_cat_obj_empty_terminal) is_cat_obj_empty_initial_op:
  "op_ntcf  : 0CF >CF.0 z : 0C ↦↦Cαop_cat "
  by (intro is_cat_obj_empty_initialI)
    (
      cs_concl cs_shallow
        cs_simp: cat_op_simps op_cf_cf_0 cs_intro: cat_cs_intros cat_op_intros
    )

lemma (in is_cat_obj_empty_terminal) is_cat_obj_empty_initial_op'[cat_op_intros]:
  assumes "ℭ' = op_cat "
  shows "op_ntcf  : 0CF >CF.0 z : 0C ↦↦Cαℭ'"
  unfolding assms by (rule is_cat_obj_empty_initial_op)

lemmas [cat_op_intros] = is_cat_obj_empty_terminal.is_cat_obj_empty_initial_op'

lemma (in is_cat_obj_empty_initial) is_cat_obj_empty_terminal_op:
  "op_ntcf  : z <CF.1 0CF : 0C ↦↦Cαop_cat "
  by (intro is_cat_obj_empty_terminalI)
    (
      cs_concl cs_shallow
        cs_simp: cat_op_simps op_cf_cf_0 cs_intro: cat_cs_intros cat_op_intros
    )

lemma (in is_cat_obj_empty_initial) is_cat_obj_empty_terminal_op'[cat_op_intros]:
  assumes "ℭ' = op_cat "
  shows "op_ntcf  : z <CF.1 0CF : 0C ↦↦Cαℭ'"
  unfolding assms by (rule is_cat_obj_empty_terminal_op)

lemmas [cat_op_intros] = is_cat_obj_empty_initial.is_cat_obj_empty_terminal_op'


text‹Elementary properties.›

lemma (in is_cat_obj_empty_terminal) cat_oet_ntcf_0: " = ntcf_0 "
  by (rule is_ntcf_is_ntcf_0_if_cat_0)
    (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

lemma (in is_cat_obj_empty_initial) cat_oei_ntcf_0: " = ntcf_0 "
  by (rule is_ntcf_is_ntcf_0_if_cat_0)
    (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)


subsubsection‹
Initial and terminal objects as limits/colimits of an empty diagram 
are initial and terminal objects
›

lemma (in category) cat_obj_terminal_is_cat_obj_empty_terminal:
  assumes "obj_terminal  z"
  shows "ntcf_0  : z <CF.1 0CF : 0C ↦↦Cα"
proof-

  from assms have z: "z  Obj" by auto
  from z have [cat_cs_simps]: "cf_const cat_0  z = cf_0 "
    by (intro is_functor_is_cf_0_if_cat_0) (cs_concl cs_intro: cat_cs_intros)
  note obj_terminalD = obj_terminalD[OF assms]

  show ?thesis
  proof
    (
      intro is_cat_obj_empty_terminalI is_cat_limitI is_cat_coneI, 
      unfold cat_cs_simps
    )
    show "∃!f'. f' : r' z  u' = ntcf_0  NTCF ntcf_const cat_0  f'"
      if "u' : r' <CF.cone cf_0  : cat_0 ↦↦Cα" for u' r'
    proof-
      interpret u': is_cat_cone α r' cat_0  cf_0  u' by (rule that)
      from z have [cat_cs_simps]: "cf_const cat_0  r' = cf_0 "
        by (intro is_functor_is_cf_0_if_cat_0) 
          (cs_concl cs_shallow cs_intro: cat_cs_intros)
      have u'_def: "u' = ntcf_0 "
        by 
          (
            rule is_ntcf_is_ntcf_0_if_cat_0[
              OF u'.is_ntcf_axioms, unfolded cat_cs_simps
              ]
          )
      from obj_terminalD(2)[OF u'.cat_cone_obj] obtain f' 
        where f': "f' : r' z"
          and f'_unique: "f'' : r' z  f'' = f'" 
        for f''
        by auto
      from f' have [cat_cs_simps]: "ntcf_const cat_0  f' = ntcf_0 "
        by (intro is_ntcf_is_ntcf_0_if_cat_0(1)) 
          (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show ?thesis
      proof(intro ex1I conjI; (elim conjE)?)
        show "u' = ntcf_0  NTCF ntcf_const cat_0  f'"
          by
            (
              cs_concl cs_shallow
                cs_simp: u'_def cat_cs_simps cs_intro: cat_cs_intros
            )
        fix f'' assume prems: 
          "f'' : r' z" "u' = ntcf_0  NTCF ntcf_const cat_0  f''"
        show "f'' = f'" by (rule f'_unique[OF prems(1)])          
      qed (rule f')
    qed
  qed (cs_concl cs_simp: cat_cs_simps cs_intro: z cat_cs_intros)

qed

lemma (in category) cat_obj_initial_is_cat_obj_empty_initial:
  assumes "obj_initial  z"
  shows "ntcf_0  : 0CF >CF.0 z : 0C ↦↦Cα"
proof-
  have z: "obj_terminal (op_cat ) z" unfolding cat_op_simps by (rule assms)
  show ?thesis
    by 
      (
        rule is_cat_obj_empty_terminal.is_cat_obj_empty_initial_op
          [
            OF category.cat_obj_terminal_is_cat_obj_empty_terminal[
              OF category_op z, folded op_ntcf_ntcf_0
              ], 
            unfolded cat_op_simps op_ntcf_ntcf_0
          ]
      )
qed

lemma (in is_cat_obj_empty_terminal) cat_oet_obj_terminal: "obj_terminal  z"
proof-
  show "obj_terminal  z"
  proof(rule obj_terminalI)
    fix a assume prems: "a  Obj"
    have [cat_cs_simps]: "cf_const cat_0  a = cf_0 "
      by (rule is_functor_is_cf_0_if_cat_0)
        (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros prems)
    from prems have "ntcf_0  : a <CF.cone cf_0  : cat_0 ↦↦Cα"
      by (intro is_cat_coneI)
        (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from cat_lim_ua_fo[OF this] obtain f' 
      where f': "f' : a z"
        and "ntcf_0  =  NTCF ntcf_const cat_0  f'"
        and f'_unique: 
          " f'' : a z; ntcf_0  =  NTCF ntcf_const cat_0  f''  
            f'' = f'"
      for f''
      by metis
    show "∃!f'. f' : a z"
    proof(intro ex1I)
      fix f'' assume prems': "f'' : a z"
      from prems' have "ntcf_0  = ntcf_0  NTCF ntcf_const cat_0  f''"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from f'_unique[OF prems', unfolded cat_oet_ntcf_0, OF this] 
      show "f'' = f'".
    qed (rule f')
  qed (rule cat_cone_obj)
qed

lemma (in is_cat_obj_empty_initial) cat_oei_obj_initial: "obj_initial  z"
  by 
    (
      rule is_cat_obj_empty_terminal.cat_oet_obj_terminal[
        OF is_cat_obj_empty_initial.is_cat_obj_empty_terminal_op[
          OF is_cat_obj_empty_initial_axioms
          ],
        unfolded cat_op_simps
        ]
    )

lemma (in category) cat_is_cat_obj_empty_terminal_obj_terminal_iff:
  "(ntcf_0  : z <CF.1 0CF : 0C ↦↦Cα)  obj_terminal  z"
  using 
    cat_obj_terminal_is_cat_obj_empty_terminal
    is_cat_obj_empty_terminal.cat_oet_obj_terminal
  by auto

lemma (in category) cat_is_cat_obj_empty_initial_obj_initial_iff:
  "(ntcf_0  : 0CF >CF.0 z : 0C ↦↦Cα)  obj_initial  z"
  using 
    cat_obj_initial_is_cat_obj_empty_initial
    is_cat_obj_empty_initial.cat_oei_obj_initial
  by auto



subsection‹Initial cone and terminal cocone›


subsubsection‹Definitions and elementary properties›

definition ntcf_initial :: "V  V  V"
  where "ntcf_initial  z =
    [
      (λbObj. THE f. f : z b),
      cf_const   z,
      cf_id ,
      ,
      
    ]"

definition ntcf_terminal :: "V  V  V"
  where "ntcf_terminal  z =
    [
      (λbObj. THE f. f : b z),
      cf_id ,
      cf_const   z,
      ,
      
    ]"


text‹Components.›

lemma ntcf_initial_components:
  shows "ntcf_initial  zNTMap = (λcObj. THE f. f : z c)"
    and "ntcf_initial  zNTDom = cf_const   z"
    and "ntcf_initial  zNTCod = cf_id "
    and "ntcf_initial  zNTDGDom = "
    and "ntcf_initial  zNTDGCod = "
  unfolding ntcf_initial_def nt_field_simps 
  by (simp_all add: nat_omega_simps)

lemmas [cat_lim_cs_simps] = ntcf_initial_components(2-5)
    
lemma ntcf_terminal_components:
  shows "ntcf_terminal  zNTMap = (λcObj. THE f. f : c z)"
    and "ntcf_terminal  zNTDom = cf_id "
    and "ntcf_terminal  zNTCod = cf_const   z"
    and "ntcf_terminal  zNTDGDom = "
    and "ntcf_terminal  zNTDGCod = "
  unfolding ntcf_terminal_def nt_field_simps 
  by (simp_all add: nat_omega_simps)

lemmas [cat_lim_cs_simps] = ntcf_terminal_components(2-5)


text‹Duality.›

lemma ntcf_initial_op[cat_op_simps]:
  "op_ntcf (ntcf_initial  z) = ntcf_terminal (op_cat ) z"
  unfolding 
    ntcf_initial_def ntcf_terminal_def op_ntcf_def 
    nt_field_simps cat_op_simps
  by (auto simp: nat_omega_simps cat_op_simps) 

lemma ntcf_cone_terminal_op[cat_op_simps]:
  "op_ntcf (ntcf_terminal  z) = ntcf_initial (op_cat ) z"
  unfolding 
    ntcf_initial_def ntcf_terminal_def op_ntcf_def 
    nt_field_simps cat_op_simps
  by (auto simp: nat_omega_simps cat_op_simps)


subsubsection‹Natural transformation map›

mk_VLambda ntcf_initial_components(1)
  |vsv ntcf_initial_vsv[cat_lim_cs_intros]|
  |vdomain ntcf_initial_vdomain[cat_lim_cs_simps]|
  |app ntcf_initial_app|

mk_VLambda ntcf_terminal_components(1)
  |vsv ntcf_terminal_vsv[cat_lim_cs_intros]|
  |vdomain ntcf_terminal_vdomain[cat_lim_cs_simps]|
  |app ntcf_terminal_app|

lemma (in category)
  assumes "obj_initial  z" and "c  Obj"
  shows ntcf_initial_NTMap_app_is_arr: 
    "ntcf_initial  zNTMapc : z c"
    and ntcf_initial_NTMap_app_unique: 
      "f'. f' : z c  f' = ntcf_initial  zNTMapc"
proof-
  from obj_initialD(2)[OF assms(1,2)] obtain f
    where f: "f : z c"
      and f_unique: "f' : z c  f' = f" 
    for f'
    by auto
  show is_arr: "ntcf_initial  zNTMapc : z c"
  proof(cs_concl_step ntcf_initial_app, rule assms(2), rule theI)
    fix f' assume "f' : z c"
    from f_unique[OF this] show "f' = f".
  qed (rule f)
  fix f' assume "f' : z c"
  from f_unique[OF this, folded f_unique[OF is_arr]] 
  show "f' = ntcf_initial  zNTMapc".
qed

lemma (in category) ntcf_initial_NTMap_app_is_arr'[cat_lim_cs_intros]:
  assumes "obj_initial  z" 
    and "c  Obj" 
    and "ℭ' = " 
    and "z' = z"
    and "c' = c"
  shows "ntcf_initial  zNTMapc : z' ℭ'c'"
  using assms(1,2) 
  unfolding assms(3-5) 
  by (rule ntcf_initial_NTMap_app_is_arr)

lemma (in category)
  assumes "obj_terminal  z" and "c  Obj"
  shows ntcf_terminal_NTMap_app_is_arr: 
    "ntcf_terminal  zNTMapc : c z"
    and ntcf_terminal_NTMap_app_unique: 
      "f'. f' : c z  f' = ntcf_terminal  zNTMapc"
proof-
  from obj_terminalD(2)[OF assms(1,2)] obtain f
    where f: "f : c z"
      and f_unique: "f' : c z  f' = f" 
    for f'
    by auto
  show is_arr: "ntcf_terminal  zNTMapc : c z"
  proof(cs_concl_step ntcf_terminal_app, rule assms(2), rule theI)
    fix f' assume "f' : c z"
    from f_unique[OF this] show "f' = f". 
  qed (rule f)
  fix f' assume "f' : c z"
  from f_unique[OF this, folded f_unique[OF is_arr]] 
  show "f' = ntcf_terminal  zNTMapc".
qed

lemma (in category) ntcf_terminal_NTMap_app_is_arr'[cat_lim_cs_intros]:
  assumes "obj_terminal  z" 
    and "c  Obj" 
    and "ℭ' = " 
    and "z' = z"
    and "c' = c"
  shows "ntcf_terminal  zNTMapc : c' ℭ'z'"
  using assms(1,2) 
  unfolding assms(3-5) 
  by (rule ntcf_terminal_NTMap_app_is_arr)



subsection‹
Initial and terminal objects as limits/colimits of the identity functor
›


subsubsection‹Definition and elementary properties›

text‹
See 
cite"noauthor_nlab_nodate"\footnote{
\url{https://ncatlab.org/nlab/show/initial+object}
}, cite"noauthor_nlab_nodate"\footnote{
\url{https://ncatlab.org/nlab/show/terminal+object}
} and Chapter X-1 in cite"mac_lane_categories_2010".
›

locale is_cat_obj_id_initial = is_cat_limit α   cf_id  z  for α  z 

syntax "_is_cat_obj_id_initial" :: "V  V  V  V  bool"
  ((_ :/ _ <CF.0 idC :/ ↦↦Cı _) [51, 51, 51] 51)
syntax_consts "_is_cat_obj_id_initial"  is_cat_obj_id_initial
translations " : z <CF.0 idC : ↦↦Cα"  
  "CONST is_cat_obj_id_initial α  z "

locale is_cat_obj_id_terminal = is_cat_colimit α   cf_id  z  for α  z 

syntax "_is_cat_obj_id_terminal" :: "V  V  V  V  bool"
  ((_ :/ idC >CF.1 _ :/ ↦↦Cı _) [51, 51, 51] 51)
syntax_consts "_is_cat_obj_id_terminal"  is_cat_obj_id_terminal
translations " : idC >CF.1 z : ↦↦Cα" 
  "CONST is_cat_obj_id_terminal α  z "


text‹Rules.›

lemma (in is_cat_obj_id_initial)
  is_cat_obj_id_initial_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "z' = z" and "ℭ' = " 
  shows " : z' <CF.0 idC : ↦↦Cαℭ'"
  unfolding assms by (rule is_cat_obj_id_initial_axioms)

mk_ide rf is_cat_obj_id_initial_def
  |intro is_cat_obj_id_initialI|
  |dest is_cat_obj_id_initialD[dest]|
  |elim is_cat_obj_id_initialE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_id_initialD

lemma (in is_cat_obj_id_terminal) 
  is_cat_obj_id_terminal_axioms'[cat_lim_cs_intros]:
  assumes "α' = α" and "z' = z" and "ℭ' = " 
  shows " : idC >CF.1 z' : ↦↦Cα'ℭ'"
  unfolding assms by (rule is_cat_obj_id_terminal_axioms)

mk_ide rf is_cat_obj_id_terminal_def
  |intro is_cat_obj_id_terminalI|
  |dest is_cat_obj_id_terminalD[dest]|
  |elim is_cat_obj_id_terminalE[elim]|

lemmas [cat_lim_cs_intros] = is_cat_obj_id_terminalD


text‹Duality.›

lemma (in is_cat_obj_id_initial) is_cat_obj_id_terminal_op:
  "op_ntcf  : idC >CF.1 z : ↦↦Cαop_cat "
  by (intro is_cat_obj_id_terminalI)
    (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)

lemma (in is_cat_obj_id_initial) is_cat_obj_id_terminal_op'[cat_op_intros]:
  assumes "ℭ' = op_cat "
  shows "op_ntcf  : idC >CF.1 z : ↦↦Cαℭ'"
  unfolding assms by (rule is_cat_obj_id_terminal_op)

lemmas [cat_op_intros] = is_cat_obj_id_initial.is_cat_obj_id_terminal_op'

lemma (in is_cat_obj_id_terminal) is_cat_obj_id_initial_op:
  "op_ntcf  : z <CF.0 idC : ↦↦Cαop_cat "
  by (intro is_cat_obj_id_initialI)
    (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_op_intros)

lemma (in is_cat_obj_id_terminal) is_cat_obj_id_initial_op'[cat_op_intros]:
  assumes "ℭ' = op_cat "
  shows "op_ntcf  : z <CF.0 idC : ↦↦Cαℭ'"
  unfolding assms by (rule is_cat_obj_id_initial_op)

lemmas [cat_op_intros] = is_cat_obj_id_terminal.is_cat_obj_id_initial_op'


subsubsection‹
Initial and terminal objects as limits/colimits are initial and terminal objects
›

lemma (in category) cat_obj_initial_is_cat_obj_id_initial:
  assumes "obj_initial  z"
  shows "ntcf_initial  z : z <CF.0 idC : ↦↦Cα"
proof(intro is_cat_obj_id_initialI is_cat_limitI)

  from assms have z: "z  Obj" by auto
  note obj_initialD = obj_initialD[OF assms]

  show "ntcf_initial  z : z <CF.cone cf_id  :  ↦↦Cα"
  proof(intro is_cat_coneI is_ntcfI', unfold cat_lim_cs_simps)
    show "vfsequence (ntcf_initial  z)"
      unfolding ntcf_initial_def by auto
    show "vcard (ntcf_initial  z) = 5"
      unfolding ntcf_initial_def by (simp add: nat_omega_simps)
    show "ntcf_initial  zNTMapa :
      cf_const   zObjMapa cf_id ObjMapa"
      if "a  Obj" for a
      using that assms(1)
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_lim_cs_intros
         )
    show 
      "ntcf_initial  zNTMapb Acf_const   zArrMapf =
        cf_id ArrMapf Antcf_initial  zNTMapa"
      if "f : a b" for a b f
    proof-
      from that assms(1) have 
        "f Antcf_initial  zNTMapa : z b"
        by (cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)
      note [cat_cs_simps] = ntcf_initial_NTMap_app_unique[
          OF assms(1) cat_is_arrD(3)[OF that] this
          ]
      from that assms(1) show ?thesis
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_lim_cs_intros
          )
    qed
  qed (use z in cs_concl cs_intro: cat_cs_intros cat_lim_cs_intros)+
  then interpret i: is_cat_cone α z   cf_id  ntcf_initial  z .

  fix u r assume "u : r <CF.cone cf_id  :  ↦↦Cα"
  then interpret u: is_cat_cone α r   cf_id  u .

  from obj_initialD(2)[OF u.cat_cone_obj] obtain f 
    where f: "f : z r" and f_unique: "f' : z r  f' = f" for f' 
    by auto
  note u.cat_cone_Comp_commute[cat_cs_simps del]
  from u.ntcf_Comp_commute[OF f] f have "uNTMapr = f AuNTMapz"
    by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show "∃!f'.
    f' : r z 
    u = ntcf_initial  z NTCF ntcf_const   f'"
  proof(intro ex1I conjI; (elim conjE)?)
    from f show "uNTMapz : r z"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "u = ntcf_initial  z NTCF ntcf_const   (uNTMapz)"
    proof(rule ntcf_eqI, rule u.is_ntcf_axioms)
      show "ntcf_initial  z NTCF ntcf_const   (uNTMapz) :
        cf_const   r CF cf_id  :  ↦↦Cα"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      from z have dom_rhs: 
        "𝒟 ((ntcf_initial  z NTCF ntcf_const   (uNTMapz))NTMap) =
          Obj" 
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      show "uNTMap =
        (ntcf_initial  z NTCF ntcf_const   (uNTMapz))NTMap"
      proof(rule vsv_eqI, unfold dom_rhs u.ntcf_NTMap_vdomain)
        fix c assume prems: "c  Obj"
        then have ic: "ntcf_initial  zNTMapc : z c"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        from u.ntcf_Comp_commute[OF ic] ic have [cat_cs_simps]: 
          "ntcf_initial  zNTMapc AuNTMapz = uNTMapc"
          by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) simp
        from prems z show "uNTMapc =
          (ntcf_initial  z NTCF ntcf_const   (uNTMapz))NTMapc"
          by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
      qed (auto intro: cat_cs_intros)
    qed simp_all
    fix f' assume prems:
      "f' : r z"
      "u = ntcf_initial  z NTCF ntcf_const   f'"
    from z have "ntcf_initial  zNTMapz : z z"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros) 
    note [cat_cs_simps] = cat_obj_initial_CId[OF assms this, symmetric]
    from prems(2) have
      "uNTMapz = (ntcf_initial  z NTCF ntcf_const   f')NTMapz"
      by simp
    from this prems(1) show "f' = uNTMapz"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros) simp
  qed
qed

lemma (in category) cat_obj_terminal_is_cat_obj_id_terminal:
  assumes "obj_terminal  z"
  shows "ntcf_terminal  z : idC >CF.1 z : ↦↦Cα"
  by 
    (
      rule is_cat_obj_id_initial.is_cat_obj_id_terminal_op
        [
          OF category.cat_obj_initial_is_cat_obj_id_initial[
            OF category_op op_cat_obj_initial[THEN iffD2, OF assms(1)]
            ],
          unfolded cat_op_simps
        ]
    )

lemma cat_cone_CId_obj_initial:
  assumes " : z <CF.cone cf_id  :  ↦↦Cα" and "NTMapz = CIdz"
  shows "obj_initial  z"
proof(intro obj_initialI)
  interpret: is_cat_cone α z   cf_id   by (rule assms(1))
  show "z  Obj" by (cs_concl cs_intro: cat_cs_intros)
  fix c assume prems: "c  Obj"
  show "∃!f. f : z c"
  proof(intro ex1I)
    from prems show ℨc: "NTMapc : z c"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    fix f assume prems': "f : z c"
    from ℨ.ntcf_Comp_commute[OF prems'] prems' ℨc show "f = NTMapc"
      by (cs_prems cs_simp: cat_cs_simps assms(2) cs_intro: cat_cs_intros) simp
  qed
qed

lemma cat_cocone_CId_obj_terminal:
  assumes " : cf_id  >CF.cocone z :  ↦↦Cα" and "NTMapz = CIdz"
  shows "obj_terminal  z"
proof-
  interpret: is_cat_cocone α z   cf_id   by (rule assms(1))
  show ?thesis
    by 
      (
        rule cat_cone_CId_obj_initial
          [
            OF ℨ.is_cat_cone_op[unfolded cat_op_simps], 
            unfolded cat_op_simps, 
            OF assms(2)
          ]
      )
qed
 
lemma (in is_cat_obj_id_initial) cat_oii_obj_initial: "obj_initial  z"
proof(rule cat_cone_CId_obj_initial, rule is_cat_cone_axioms)
  from cat_lim_unique_cone'[OF is_cat_cone_axioms] obtain f 
    where f: "f : z z"
      and ℨ'j: "j. j  Obj  NTMapj = NTMapj Af"
      and f_unique:
        "
          f' : z z;
          j. j  Obj  NTMapj = NTMapj Af'
           f' = f"
    for f'
    by metis
  have CId_z: "CIdz : z z"
    by (cs_concl cs_intro: cat_cs_intros)
  have "NTMapj = NTMapj ACIdz" if "j  Obj" for j
    using that by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f_unique[OF CId_z this] have CId_f: "CIdz = f" .
  have ℨz: "NTMapz : z z"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  have "NTMapc = NTMapc ANTMapz" if "c  Obj" for c
  proof-
    from that have ℨc: "NTMapc : z c"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    note cat_cone_Comp_commute[cat_cs_simps del]
    from ntcf_Comp_commute[OF ℨc] ℨc show
      "NTMapc = NTMapc ANTMapz"
      by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed
  from f_unique[OF ℨz this] have "NTMapz = f" .
  with CId_f show "NTMapz = CIdz" by simp
qed

lemma (in is_cat_obj_id_terminal) cat_oit_obj_terminal: "obj_terminal  z"
  by 
    (
      rule is_cat_obj_id_initial.cat_oii_obj_initial[
        OF is_cat_obj_id_initial_op, unfolded cat_op_simps
        ]
    )

lemma (in category) cat_is_cat_obj_id_initial_obj_initial_iff:
  "(ntcf_initial  z : z <CF.0 idC : ↦↦Cα)  obj_initial  z"
  using 
    cat_obj_initial_is_cat_obj_id_initial
    is_cat_obj_id_initial.cat_oii_obj_initial
  by auto

lemma (in category) cat_is_cat_obj_id_terminal_obj_terminal_iff:
  "(ntcf_terminal  z : idC >CF.1 z : ↦↦Cα)  obj_terminal  z"
  using 
    cat_obj_terminal_is_cat_obj_id_terminal
    is_cat_obj_id_terminal.cat_oit_obj_terminal
  by auto

text‹\newpage›

end