Theory CZH_UCAT_Pointed
section‹Pointed arrows and natural transformations›
theory CZH_UCAT_Pointed
  imports 
    CZH_Elementary_Categories.CZH_ECAT_NTCF
    CZH_Elementary_Categories.CZH_ECAT_Hom
begin
subsection‹Pointed arrow›
text‹
The terminology that is used in this section deviates from convention: a 
pointed arrow is merely an arrow in ‹Set› from a singleton set to another set.
›
subsubsection‹Definition and elementary properties›
text‹See Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.›
definition ntcf_paa :: "V ⇒ V ⇒ V ⇒ V"
  where "ntcf_paa 𝔞 B b = [(λa∈⇩∘set {𝔞}. b), set {𝔞}, B]⇩∘"
text‹Components.›
lemma ntcf_paa_components:
  shows "ntcf_paa 𝔞 B b⦇ArrVal⦈ = (λa∈⇩∘set {𝔞}. b)"
    and [cat_cs_simps]: "ntcf_paa 𝔞 B b⦇ArrDom⦈ = set {𝔞}"
    and [cat_cs_simps]: "ntcf_paa 𝔞 B b⦇ArrCod⦈ = B"
  unfolding ntcf_paa_def arr_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Arrow value›
mk_VLambda ntcf_paa_components(1)
  |vsv ntcf_paa_ArrVal_vsv[cat_cs_intros]|
  |vdomain ntcf_paa_ArrVal_vdomain[cat_cs_simps]|
  |app ntcf_paa_ArrVal_app[unfolded vsingleton_iff, cat_cs_simps]|
subsubsection‹Pointed arrow is an arrow in ‹Set››
lemma (in 𝒵) ntcf_paa_is_arr:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" and "A ∈⇩∘ cat_Set α⦇Obj⦈" and "a ∈⇩∘ A"
  shows "ntcf_paa 𝔞 A a : set {𝔞} ↦⇘cat_Set α⇙ A"
proof(intro cat_Set_is_arrI arr_SetI cat_cs_intros, unfold cat_cs_simps)
  show "vfsequence (ntcf_paa 𝔞 A a)" unfolding ntcf_paa_def by simp
  show "vcard (ntcf_paa 𝔞 A a) = 3⇩ℕ"
    unfolding ntcf_paa_def by (simp add: nat_omega_simps)
  show "ℛ⇩∘ (ntcf_paa 𝔞 A a⦇ArrVal⦈) ⊆⇩∘ A"
    unfolding ntcf_paa_components by (intro vrange_VLambda_vsubset assms)
qed (use assms in ‹auto simp: cat_Set_components(1) Limit_vsingleton_in_VsetI›)
lemma (in 𝒵) ntcf_paa_is_arr'[cat_cs_intros]:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" 
    and "A ∈⇩∘ cat_Set α⦇Obj⦈" 
    and "a ∈⇩∘ A"
    and "A' = set {𝔞}"
    and "B' = A"
    and "ℭ' = cat_Set α"
  shows "ntcf_paa 𝔞 A a : A' ↦⇘ℭ'⇙ B'"
  using assms(1-3) unfolding assms(4-6) by (rule ntcf_paa_is_arr) 
lemmas [cat_cs_intros] = 𝒵.ntcf_paa_is_arr'
subsubsection‹Further properties›
lemma ntcf_paa_injective[cat_cs_simps]: 
  "ntcf_paa 𝔞 A b = ntcf_paa 𝔞 A c ⟷ b = c"
proof
  assume "ntcf_paa 𝔞 A b = ntcf_paa 𝔞 A c"
  then have "ntcf_paa 𝔞 A b⦇ArrVal⦈⦇𝔞⦈ = ntcf_paa 𝔞 A c⦇ArrVal⦈⦇𝔞⦈" by simp
  then show "b = c" by (cs_prems cs_simp: cat_cs_simps)
qed simp
lemma (in 𝒵) ntcf_paa_ArrVal:
  assumes "F : set {𝔞} ↦⇘cat_Set α⇙ X"
  shows "ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇𝔞⦈) = F"
proof-
  interpret F: arr_Set α F
    rewrites [cat_cs_simps]: "F⦇ArrDom⦈ = set {𝔞}" 
      and [cat_cs_simps]: "F⦇ArrCod⦈ = X"
    by (auto simp: cat_Set_is_arrD[OF assms])
  from F.arr_Par_ArrDom_in_Vset have 𝔞: "𝔞 ∈⇩∘ Vset α" by auto
  from assms 𝔞 F.arr_Par_ArrCod_in_Vset have lhs_is_arr:
    "ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇𝔞⦈) : set {𝔞} ↦⇘cat_Set α⇙ X"
    by
      (
        cs_concl cs_shallow 
          cs_simp: cat_Set_components(1)
          cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
      )
  then have dom_lhs: "𝒟⇩∘ (ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇𝔞⦈)⦇ArrVal⦈) = set {𝔞}"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from assms have dom_rhs: "𝒟⇩∘ (F⦇ArrVal⦈) = set {𝔞}" 
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  show ?thesis
  proof(rule arr_Set_eqI)
    from lhs_is_arr assms 
    show arr_Set_lhs: "arr_Set α (ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇𝔞⦈))" 
      and arr_Set_rhs: "arr_Set α F"
      by (auto dest: cat_Set_is_arrD)
    show "ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇𝔞⦈)⦇ArrVal⦈ = F⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs vsingleton_iff; (simp only:)?)
      show "ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇𝔞⦈)⦇ArrVal⦈⦇𝔞⦈ = F⦇ArrVal⦈⦇𝔞⦈"
        by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed (use assms in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
lemma (in 𝒵) ntcf_paa_ArrVal':
  assumes "F : set {𝔞} ↦⇘cat_Set α⇙ X" and "a = 𝔞"
  shows "ntcf_paa 𝔞 X (F⦇ArrVal⦈⦇a⦈) = F"
  using assms(1) unfolding assms(2) by (rule ntcf_paa_ArrVal)
lemma (in 𝒵) ntcf_paa_Comp_right[cat_cs_simps]:
  assumes "F : A ↦⇘cat_Set α⇙ B" 
    and "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" 
    and "a ∈⇩∘ A"
  shows "F ∘⇩A⇘cat_Set α⇙ ntcf_paa 𝔞 A a = ntcf_paa 𝔞 B (F⦇ArrVal⦈⦇a⦈)"
proof-
  from assms have F_paa:
    "F ∘⇩A⇘cat_Set α⇙ ntcf_paa 𝔞 A a : set {𝔞} ↦⇘cat_Set α⇙ B"
    by (cs_concl cs_intro: cat_cs_intros)
  then have dom_lhs: "𝒟⇩∘ ((F ∘⇩A⇘cat_Set α⇙ ntcf_paa 𝔞 A a)⦇ArrVal⦈) = set {𝔞}"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from assms have paa: "ntcf_paa 𝔞 B (F⦇ArrVal⦈⦇a⦈) : set {𝔞} ↦⇘cat_Set α⇙ B"
    by (cs_concl cs_shallow cs_intro: cat_Set_cs_intros cat_cs_intros)
  then have dom_rhs: "𝒟⇩∘ ((ntcf_paa 𝔞 B (F⦇ArrVal⦈⦇a⦈))⦇ArrVal⦈) = set {𝔞}"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  show ?thesis
  proof(rule arr_Set_eqI)
    from F_paa paa assms 
    show arr_Set_lhs: "arr_Set α (F ∘⇩A⇘cat_Set α⇙ ntcf_paa 𝔞 A a)" 
      and arr_Set_rhs: "arr_Set α (ntcf_paa 𝔞 B (F⦇ArrVal⦈⦇a⦈))"
      by (auto dest: cat_Set_is_arrD)
    show 
      "(F ∘⇩A⇘cat_Set α⇙ ntcf_paa 𝔞 A a)⦇ArrVal⦈ =
        ntcf_paa 𝔞 B (F⦇ArrVal⦈⦇a⦈)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs vsingleton_iff; (simp only:)?)
      from assms show 
        "(F ∘⇩A⇘cat_Set α⇙ ntcf_paa 𝔞 A a)⦇ArrVal⦈⦇𝔞⦈ =
          ntcf_paa 𝔞 B (F⦇ArrVal⦈⦇a⦈)⦇ArrVal⦈⦇𝔞⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed (use F_paa paa in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
lemmas [cat_cs_simps] = 𝒵.ntcf_paa_Comp_right
subsection‹Pointed natural transformation›
subsubsection‹Definition and elementary properties›
text‹See Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.›
definition ntcf_pointed :: "V ⇒ V ⇒ V"
  where "ntcf_pointed α 𝔞 =
    [
      (
        λx∈⇩∘cat_Set α⦇Obj⦈.
          [
            (λf∈⇩∘Hom (cat_Set α) (set {𝔞}) x. f⦇ArrVal⦈⦇𝔞⦈),
            Hom (cat_Set α) (set {𝔞}) x,
            x
          ]⇩∘
      ),
      Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-),
      cf_id (cat_Set α),
      cat_Set α,
      cat_Set α
    ]⇩∘"
text‹Components.›
lemma ntcf_pointed_components:
  shows "ntcf_pointed α 𝔞⦇NTMap⦈ =
      (
        λx∈⇩∘cat_Set α⦇Obj⦈.
          [
            (λf∈⇩∘Hom (cat_Set α) (set {𝔞}) x. f⦇ArrVal⦈⦇𝔞⦈),
            Hom (cat_Set α) (set {𝔞}) x, 
            x
          ]⇩∘
      )"
    and [cat_cs_simps]: "ntcf_pointed α 𝔞⦇NTDom⦈ = Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)"
    and [cat_cs_simps]: "ntcf_pointed α 𝔞⦇NTCod⦈ = cf_id (cat_Set α)"
    and [cat_cs_simps]: "ntcf_pointed α 𝔞⦇NTDGDom⦈ = cat_Set α"
    and [cat_cs_simps]: "ntcf_pointed α 𝔞⦇NTDGCod⦈ = cat_Set α"
  unfolding ntcf_pointed_def nt_field_simps by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda ntcf_pointed_components(1)
  |vsv ntcf_pointed_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_pointed_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_pointed_NTMap_app'|
lemma (in 𝒵) ntcf_pointed_NTMap_app_ArrVal_app[cat_cs_simps]: 
  assumes "X ∈⇩∘ cat_Set α⦇Obj⦈" and "F : set {𝔞} ↦⇘cat_Set α⇙ X"
  shows "ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈⦇F⦈ = F⦇ArrVal⦈⦇𝔞⦈"
  by (simp add: assms(2) ntcf_pointed_NTMap_app'[OF assms(1)] arr_Rel_components)
lemma (in 𝒵) ntcf_pointed_NTMap_app_is_iso_arr: 
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" and "X ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈ :
    Hom (cat_Set α) (set {𝔞}) X ↦⇩i⇩s⇩o⇘cat_Set α⇙ X"
proof-
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
  note app_X = ntcf_pointed_NTMap_app'[OF assms(2)]
  show ?thesis 
  proof(intro cat_Set_is_iso_arrI cat_Set_is_arrI arr_SetI)
    show ArrVal_vsv: "vsv (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈)"
      unfolding app_X arr_Rel_components by simp
    show "vcard (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈) = 3⇩ℕ"
      unfolding app_X arr_Rel_components by (simp add: nat_omega_simps)
    show ArrVal_vdomain: 
      "𝒟⇩∘ (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈) = Hom (cat_Set α) (set {𝔞}) X"
      unfolding app_X arr_Rel_components by simp
    show vrange_left: 
      "ℛ⇩∘ (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈) ⊆⇩∘
        ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrCod⦈"
      unfolding app_X arr_Rel_components 
      by
        (
          auto
            simp: in_Hom_iff
            intro: cat_Set_cs_intros
            intro!: vrange_VLambda_vsubset
        )
    show "ℛ⇩∘ (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈) = X"
    proof(intro vsubset_antisym)
      show "X ⊆⇩∘ ℛ⇩∘ (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈)"
      proof(intro vsubsetI)
        fix x assume prems: "x ∈⇩∘ X"
        from assms prems have F_in_vdomain: 
          "ntcf_paa 𝔞 X x ∈⇩∘ 𝒟⇩∘ ((ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈))"
          unfolding app_X arr_Rel_components vdomain_VLambda in_Hom_iff
          by (cs_concl cs_shallow cs_intro: cat_cs_intros)
        from assms prems have x_def: 
          "x = ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈⦇ntcf_paa 𝔞 X x⦈"
          by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
        show "x ∈⇩∘ ℛ⇩∘ (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈)"
           by (subst x_def) (intro vsv.vsv_vimageI2 F_in_vdomain ArrVal_vsv)
      qed
    qed (use vrange_left in ‹simp add: app_X arr_Rel_components›)
    from assms show "ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrDom⦈ ∈⇩∘ Vset α"
      unfolding app_X arr_Rel_components cat_Set_components(1) 
      by (intro Set.cat_Hom_in_Vset[OF _ assms(2)])
        (auto simp: cat_Set_components(1))
    show "v11 (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈)"
    proof(intro vsv.vsv_valeq_v11I ArrVal_vsv, unfold ArrVal_vdomain in_Hom_iff)
      fix F G assume prems:
        "F : set {𝔞} ↦⇘cat_Set α⇙ X"
        "G : set {𝔞} ↦⇘cat_Set α⇙ X"
        "ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈⦇F⦈ =
          ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈⦇G⦈"
      note F = cat_Set_is_arrD[OF prems(1)] and G = cat_Set_is_arrD[OF prems(2)]
      from prems(3,1,2) assms have F_ArrVal_G_ArrVal: "F⦇ArrVal⦈⦇𝔞⦈ = G⦇ArrVal⦈⦇𝔞⦈"
        by (cs_prems cs_simp: cat_cs_simps)
      interpret F: arr_Set α F + G: arr_Set α G by (simp_all add: F G)
      show "F = G"
      proof(rule arr_Set_eqI)
        show "arr_Set α F" "arr_Set α G" 
          by (intro F.arr_Set_axioms G.arr_Set_axioms)+
        show "F⦇ArrVal⦈ = G⦇ArrVal⦈"
          by 
            (
              rule vsv_eqI, 
              unfold F.arr_Set_ArrVal_vdomain G.arr_Set_ArrVal_vdomain F(2) G(2)
            )
            (auto simp: F_ArrVal_G_ArrVal)
      qed (simp_all add: F G)
    qed
  qed (use assms in ‹auto simp: app_X arr_Rel_components cat_Set_components(1)›)
qed
lemma (in 𝒵) ntcf_pointed_NTMap_app_is_iso_arr'[cat_cs_intros]: 
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" 
    and "X ∈⇩∘ cat_Set α⦇Obj⦈"
    and "A' = Hom (cat_Set α) (set {𝔞}) X"
    and "B' = X"
    and "ℭ' = cat_Set α"
  shows "ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈ : A' ↦⇩i⇩s⇩o⇘ℭ'⇙ B'"
  using assms(1,2)
  unfolding assms(3-5)
  by (rule ntcf_pointed_NTMap_app_is_iso_arr)
lemmas [cat_cs_intros] = 𝒵.ntcf_pointed_NTMap_app_is_iso_arr'
lemmas (in 𝒵) ntcf_pointed_NTMap_app_is_arr'[cat_cs_intros] = 
  is_iso_arrD(1)[OF 𝒵.ntcf_pointed_NTMap_app_is_iso_arr']
lemmas [cat_cs_intros] = 𝒵.ntcf_pointed_NTMap_app_is_arr'
subsubsection‹Pointed natural transformation is a natural isomorphism›
lemma (in 𝒵) ntcf_pointed_is_iso_ntcf:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "ntcf_pointed α 𝔞 :
    Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-) ↦⇩C⇩F⇩.⇩i⇩s⇩o cf_id (cat_Set α) :
    cat_Set α ↦↦⇩C⇘α⇙ cat_Set α"
proof(intro is_iso_ntcfI is_ntcfI')
  note 𝔞 = assms[unfolded cat_Set_components(1)]
  from assms have set_𝔞: "set {𝔞} ∈⇩∘ cat_Set α⦇Obj⦈" 
    unfolding cat_Set_components by auto
  show "vfsequence (ntcf_pointed α 𝔞)" unfolding ntcf_pointed_def by auto
  show "vcard (ntcf_pointed α 𝔞) = 5⇩ℕ"
    unfolding ntcf_pointed_def by (auto simp: nat_omega_simps)
  from assms set_𝔞 show 
    "Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-) : cat_Set α ↦↦⇩C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "ntcf_pointed α 𝔞⦇NTMap⦈⦇a⦈ :
    Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙
    cf_id (cat_Set α)⦇ObjMap⦈⦇a⦈"
    if "a ∈⇩∘ cat_Set α⦇Obj⦈" for a
    using assms that set_𝔞
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
      )
  show 
    "ntcf_pointed α 𝔞⦇NTMap⦈⦇b⦈ ∘⇩A⇘cat_Set α⇙
      Hom⇩O⇩.⇩C⇘α⇙cat_Set α (set {𝔞},-)⦇ArrMap⦈⦇f⦈ =
        cf_id (cat_Set α)⦇ArrMap⦈⦇f⦈ ∘⇩A⇘cat_Set α⇙ ntcf_pointed α 𝔞⦇NTMap⦈⦇a⦈"
    if "f : a ↦⇘cat_Set α⇙ b" for a b f
  proof-
    let ?pb = ‹ntcf_pointed α 𝔞⦇NTMap⦈⦇b⦈›
      and ?pa = ‹ntcf_pointed α 𝔞⦇NTMap⦈⦇a⦈›
      and ?hom = ‹cf_hom (cat_Set α) [cat_Set α⦇CId⦈⦇set {𝔞}⦈, f]⇩∘›
    from assms set_𝔞 that have pb_hom: 
      "?pb ∘⇩A⇘cat_Set α⇙ ?hom : Hom (cat_Set α) (set {𝔞}) a ↦⇘cat_Set α⇙ b"
      by 
        (
          cs_concl cs_shallow 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
    then have dom_lhs: 
      "𝒟⇩∘ ((?pb ∘⇩A⇘cat_Set α⇙ ?hom)⦇ArrVal⦈) = Hom (cat_Set α) (set {𝔞}) a"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    from assms set_𝔞 that have f_pa:
      "f ∘⇩A⇘cat_Set α⇙ ?pa : Hom (cat_Set α) (set {𝔞}) a ↦⇘cat_Set α⇙ b"
      by (cs_concl cs_intro: cat_cs_intros)
    then have dom_rhs: 
      "𝒟⇩∘ ((f ∘⇩A⇘cat_Set α⇙ ?pa)⦇ArrVal⦈) = Hom (cat_Set α) (set {𝔞}) a"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    have [cat_cs_simps]: "?pb ∘⇩A⇘cat_Set α⇙ ?hom = f ∘⇩A⇘cat_Set α⇙ ?pa"
    proof(rule arr_Set_eqI)
      from pb_hom show arr_Set_pb_hom: "arr_Set α (?pb ∘⇩A⇘cat_Set α⇙ ?hom)"
        by (auto dest: cat_Set_is_arrD(1))
      from f_pa show arr_Set_f_pa: "arr_Set α (f ∘⇩A⇘cat_Set α⇙ ?pa)"
        by (auto dest: cat_Set_is_arrD(1))
      show "(?pb ∘⇩A⇘cat_Set α⇙ ?hom)⦇ArrVal⦈ = (f ∘⇩A⇘cat_Set α⇙ ?pa)⦇ArrVal⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
        fix g assume "g : set {𝔞} ↦⇘cat_Set α⇙ a"
        with assms 𝔞 set_𝔞 that show 
          "(?pb ∘⇩A⇘cat_Set α⇙ ?hom)⦇ArrVal⦈⦇g⦈ = (f ∘⇩A⇘cat_Set α⇙ ?pa)⦇ArrVal⦈⦇g⦈"
          by
            (
              cs_concl cs_shallow
                cs_simp: V_cs_simps cat_cs_simps 
                cs_intro:
                  V_cs_intros cat_cs_intros cat_op_intros cat_prod_cs_intros
            )
      qed (use arr_Set_pb_hom arr_Set_f_pa in auto)
    qed (use pb_hom f_pa in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
    from assms that set_𝔞 show ?thesis
      by 
        (
          cs_concl cs_shallow 
            cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
        )
  qed
  show "ntcf_pointed α 𝔞⦇NTMap⦈⦇a⦈ :
    Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)⦇ObjMap⦈⦇a⦈ ↦⇩i⇩s⇩o⇘cat_Set α⇙
    cf_id (cat_Set α)⦇ObjMap⦈⦇a⦈"
    if "a ∈⇩∘ cat_Set α⦇Obj⦈" for a
    using assms 𝔞 set_𝔞 that
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
      )
qed (auto simp: ntcf_pointed_components intro: cat_cs_intros)
lemma (in 𝒵) ntcf_pointed_is_iso_ntcf'[cat_cs_intros]:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
    and "𝔉' = Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)"
    and "𝔊' = cf_id (cat_Set α)"
    and "𝔄' = cat_Set α"
    and "𝔅' = cat_Set α"
    and "α' = α"
  shows "ntcf_pointed α 𝔞 : 𝔉' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊' : 𝔄' ↦↦⇩C⇘α'⇙ 𝔅'"
  using assms(1) unfolding assms(2-6) by (rule ntcf_pointed_is_iso_ntcf)
lemmas [cat_cs_intros] = 𝒵.ntcf_pointed_is_iso_ntcf'
subsection‹Inverse pointed natural transformation›
subsubsection‹Definition and elementary properties›
text‹See Chapter III-2 in \<^cite>‹"mac_lane_categories_2010"›.›
definition ntcf_pointed_inv :: "V ⇒ V ⇒ V"
  where "ntcf_pointed_inv α 𝔞 =
    [
      (
        λX∈⇩∘cat_Set α⦇Obj⦈.
          [(λx∈⇩∘X. ntcf_paa 𝔞 X x), X, Hom (cat_Set α) (set {𝔞}) X]⇩∘
      ),
      cf_id (cat_Set α),
      Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-),
      cat_Set α,
      cat_Set α
    ]⇩∘"
text‹Components.›
lemma ntcf_pointed_inv_components:
  shows "ntcf_pointed_inv α 𝔞⦇NTMap⦈ =
      (
        λX∈⇩∘cat_Set α⦇Obj⦈.
          [(λx∈⇩∘X. ntcf_paa 𝔞 X x), X, Hom (cat_Set α) (set {𝔞}) X]⇩∘
      )"
    and [cat_cs_simps]: "ntcf_pointed_inv α 𝔞⦇NTDom⦈ = cf_id (cat_Set α)"
    and [cat_cs_simps]: 
      "ntcf_pointed_inv α 𝔞⦇NTCod⦈ = Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)"
    and [cat_cs_simps]: "ntcf_pointed_inv α 𝔞⦇NTDGDom⦈ = cat_Set α"
    and [cat_cs_simps]: "ntcf_pointed_inv α 𝔞⦇NTDGCod⦈ = cat_Set α"
  unfolding ntcf_pointed_inv_def nt_field_simps
  by (simp_all add: nat_omega_simps)
subsubsection‹Natural transformation map›
mk_VLambda ntcf_pointed_inv_components(1)
  |vsv ntcf_pointed_inv_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_pointed_inv_NTMap_vdomain[cat_cs_simps]|
  |app ntcf_pointed_inv_NTMap_app'|
lemma (in 𝒵) ntcf_pointed_inv_NTMap_app_ArrVal_app[cat_cs_simps]: 
  assumes "X ∈⇩∘ cat_Set α⦇Obj⦈" and "x ∈⇩∘ X"
  shows "ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈⦇x⦈ = ntcf_paa 𝔞 X x"
  by 
    (
      simp add: 
        assms(2) ntcf_pointed_inv_NTMap_app'[OF assms(1)] arr_Rel_components
    )
lemma (in 𝒵) ntcf_pointed_inv_NTMap_app_is_arr: 
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" and "X ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈ :
    X ↦⇘cat_Set α⇙ Hom (cat_Set α) (set {𝔞}) X"
proof-
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
  note app_X = ntcf_pointed_inv_NTMap_app'[OF assms(2)]
  show ?thesis 
  proof(intro cat_Set_is_arrI arr_SetI)
    show ArrVal_vsv: "vsv (ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈)"
      unfolding app_X arr_Rel_components by simp
    show "vcard (ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈) = 3⇩ℕ"
      unfolding app_X arr_Rel_components by (simp add: nat_omega_simps)
    show ArrVal_vdomain: 
      "𝒟⇩∘ (ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈) =
        ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrDom⦈"
      unfolding app_X arr_Rel_components by simp
    from assms show vrange_left: 
      "ℛ⇩∘ (ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrVal⦈) ⊆⇩∘
        ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrCod⦈"
      unfolding app_X arr_Rel_components by (auto intro: cat_cs_intros)
    from assms show "ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈⦇ArrCod⦈ ∈⇩∘ Vset α"
      unfolding app_X arr_Rel_components cat_Set_components(1) 
      by (intro Set.cat_Hom_in_Vset[OF _ assms(2)])
        (auto simp: cat_Set_components(1))  
  qed (use assms in ‹auto simp: app_X arr_Rel_components cat_Set_components(1)›)
qed
lemma (in 𝒵) ntcf_pointed_inv_NTMap_app_is_arr'[cat_cs_intros]: 
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" 
    and "X ∈⇩∘ cat_Set α⦇Obj⦈"
    and "A' = X"
    and "B' = Hom (cat_Set α) (set {𝔞}) X"
    and "ℭ' = cat_Set α"
  shows "ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈ : A' ↦⇘ℭ'⇙ B'"
  using assms(1,2) 
  unfolding assms(3-5) 
  by (rule ntcf_pointed_inv_NTMap_app_is_arr)
lemmas [cat_cs_intros] = 𝒵.ntcf_pointed_inv_NTMap_app_is_arr'
lemma (in 𝒵) is_inverse_ntcf_pointed_inv_NTMap_app:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈" and "X ∈⇩∘ cat_Set α⦇Obj⦈"
  shows 
    "is_inverse
      (cat_Set α)
      (ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇X⦈)
      (ntcf_pointed α 𝔞⦇NTMap⦈⦇X⦈)"
  (is ‹is_inverse (cat_Set α) ?bwd ?fwd›)
proof(intro is_inverseI)
  let ?Hom = ‹Hom (cat_Set α) (set {𝔞}) X›
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
  from assms(1) have set_𝔞: "set {𝔞} ∈⇩∘ cat_Set α⦇Obj⦈"
    unfolding cat_Set_components(1) by blast
  have Hom_𝔞X: "?Hom ∈⇩∘ cat_Set α⦇Obj⦈"
     by
       (
         auto 
          simp: cat_Set_components(1) 
          intro!: Set.cat_Hom_in_Vset set_𝔞 assms(2)
       )
  from assms show "?bwd : X ↦⇘cat_Set α⇙ ?Hom"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  from assms show "?fwd : ?Hom ↦⇘cat_Set α⇙ X"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  from assms set_𝔞 Hom_𝔞X have lhs_is_arr:
    "?bwd ∘⇩A⇘cat_Set α⇙ ?fwd : ?Hom ↦⇘cat_Set α⇙ ?Hom"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_lhs: "𝒟⇩∘ ((?bwd ∘⇩A⇘cat_Set α⇙ ?fwd)⦇ArrVal⦈) = ?Hom"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from Hom_𝔞X have rhs_is_arr: "cat_Set α⦇CId⦈⦇?Hom⦈ : ?Hom ↦⇘cat_Set α⇙ ?Hom"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_rhs: "𝒟⇩∘ ((cat_Set α⦇CId⦈⦇?Hom⦈)⦇ArrVal⦈) = ?Hom"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  show "?bwd ∘⇩A⇘cat_Set α⇙ ?fwd = cat_Set α⦇CId⦈⦇?Hom⦈"
  proof(rule arr_Set_eqI)
    from lhs_is_arr show arr_Set_lhs: "arr_Set α (?bwd ∘⇩A⇘cat_Set α⇙ ?fwd)"
      by (auto dest: cat_Set_is_arrD)
    from rhs_is_arr show arr_Set_rhs: "arr_Set α (cat_Set α⦇CId⦈⦇?Hom⦈)"
      by (auto dest: cat_Set_is_arrD)
    show "(?bwd ∘⇩A⇘cat_Set α⇙ ?fwd)⦇ArrVal⦈ = cat_Set α⦇CId⦈⦇?Hom⦈⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix F assume "F : set {𝔞} ↦⇘cat_Set α⇙ X"
      with assms Hom_𝔞X show 
        "(?bwd ∘⇩A⇘cat_Set α⇙ ?fwd)⦇ArrVal⦈⦇F⦈ = cat_Set α⦇CId⦈⦇?Hom⦈⦇ArrVal⦈⦇F⦈"
        by
          (
            cs_concl  
              cs_simp: cat_cs_simps ntcf_paa_ArrVal
              cs_intro: V_cs_intros cat_Set_cs_intros cat_cs_intros
          )
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed (use lhs_is_arr rhs_is_arr in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
  from assms have lhs_is_arr: "?fwd ∘⇩A⇘cat_Set α⇙ ?bwd : X ↦⇘cat_Set α⇙ X"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_lhs: "𝒟⇩∘ ((?fwd ∘⇩A⇘cat_Set α⇙ ?bwd)⦇ArrVal⦈) = X"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from assms have rhs_is_arr: "cat_Set α⦇CId⦈⦇X⦈ : X ↦⇘cat_Set α⇙ X"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have dom_rhs: "𝒟⇩∘ ((cat_Set α⦇CId⦈⦇X⦈)⦇ArrVal⦈) = X"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  show "?fwd ∘⇩A⇘cat_Set α⇙ ?bwd = cat_Set α⦇CId⦈⦇X⦈"
  proof(rule arr_Set_eqI)
    from lhs_is_arr show arr_Set_lhs: "arr_Set α (?fwd ∘⇩A⇘cat_Set α⇙ ?bwd)"
      by (auto dest: cat_Set_is_arrD)
    from rhs_is_arr show arr_Set_rhs: "arr_Set α (cat_Set α⦇CId⦈⦇X⦈)"
      by (auto dest: cat_Set_is_arrD)
    show "(?fwd ∘⇩A⇘cat_Set α⇙ ?bwd)⦇ArrVal⦈ = cat_Set α⦇CId⦈⦇X⦈⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix x assume "x ∈⇩∘ X"
      with assms show 
        "(?fwd ∘⇩A⇘cat_Set α⇙ ?bwd)⦇ArrVal⦈⦇x⦈ = cat_Set α⦇CId⦈⦇X⦈⦇ArrVal⦈⦇x⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (use arr_Set_lhs arr_Set_rhs in auto)
  qed (use lhs_is_arr rhs_is_arr in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
qed
subsubsection‹Inverse pointed natural transformation is a natural isomorphism›
lemma (in 𝒵) ntcf_pointed_inv_is_ntcf:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "ntcf_pointed_inv α 𝔞 :
    cf_id (cat_Set α) ↦⇩C⇩F Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-) :
    cat_Set α ↦↦⇩C⇘α⇙ cat_Set α"
proof(intro is_ntcfI')
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
  note 𝔞 = assms[unfolded cat_Set_components(1)]
  from assms have set_𝔞: "set {𝔞} ∈⇩∘ cat_Set α⦇Obj⦈" 
    unfolding cat_Set_components by auto
  show "vfsequence (ntcf_pointed_inv α 𝔞)" 
    unfolding ntcf_pointed_inv_def by simp
  show "vcard (ntcf_pointed_inv α 𝔞) = 5⇩ℕ"
    unfolding ntcf_pointed_inv_def by (simp add: nat_omega_simps)
  from set_𝔞 show "Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-) : cat_Set α ↦↦⇩C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  show "ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇a⦈ :
    cf_id (cat_Set α)⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙
    Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)⦇ObjMap⦈⦇a⦈"
    if "a ∈⇩∘ cat_Set α⦇Obj⦈" for a
    using that assms set_𝔞
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
      )
  show 
    "ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇B⦈ ∘⇩A⇘cat_Set α⇙ cf_id (cat_Set α)⦇ArrMap⦈⦇F⦈ =
      Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)⦇ArrMap⦈⦇F⦈ ∘⇩A⇘cat_Set α⇙
        ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇A⦈"
    if "F : A ↦⇘cat_Set α⇙ B" for A B F
  proof-
    let ?pb = ‹ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇B⦈›
      and ?pa = ‹ntcf_pointed_inv α 𝔞⦇NTMap⦈⦇A⦈›
      and ?hom = ‹cf_hom (cat_Set α) [cat_Set α⦇CId⦈⦇set {𝔞}⦈, F]⇩∘›
    from assms set_𝔞 that have pb_F: 
      "?pb ∘⇩A⇘cat_Set α⇙ F : A ↦⇘cat_Set α⇙ Hom (cat_Set α) (set {𝔞}) B"
      by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_prod_cs_intros)
    then have dom_lhs: "𝒟⇩∘ ((?pb ∘⇩A⇘cat_Set α⇙ F)⦇ArrVal⦈) = A"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    from that assms set_𝔞 that have hom_pa:
      "?hom ∘⇩A⇘cat_Set α⇙ ?pa : A ↦⇘cat_Set α⇙ Hom (cat_Set α) (set {𝔞}) B"
      by (cs_concl cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros)
    then have dom_rhs: "𝒟⇩∘ ((?hom ∘⇩A⇘cat_Set α⇙ ?pa)⦇ArrVal⦈) = A"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    have [cat_cs_simps]: "?pb ∘⇩A⇘cat_Set α⇙ F = ?hom ∘⇩A⇘cat_Set α⇙ ?pa"
    proof(rule arr_Set_eqI)
      from pb_F show arr_Set_pb_F: "arr_Set α (?pb ∘⇩A⇘cat_Set α⇙ F)"
        by (auto dest: cat_Set_is_arrD(1))
      from hom_pa show arr_Set_hom_pa: "arr_Set α (?hom ∘⇩A⇘cat_Set α⇙ ?pa)"
        by (auto dest: cat_Set_is_arrD(1))
      show "(?pb ∘⇩A⇘cat_Set α⇙ F)⦇ArrVal⦈ = (?hom ∘⇩A⇘cat_Set α⇙ ?pa)⦇ArrVal⦈"
      proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
        fix a assume "a ∈⇩∘ A"
        with assms 𝔞 set_𝔞 that show 
          "(?pb ∘⇩A⇘cat_Set α⇙ F)⦇ArrVal⦈⦇a⦈ = (?hom ∘⇩A⇘cat_Set α⇙ ?pa)⦇ArrVal⦈⦇a⦈"
          by
            (
              cs_concl 
                cs_simp: cat_cs_simps
                cs_intro: 
                  cat_Set_cs_intros
                  cat_cs_intros
                  cat_prod_cs_intros
                  cat_op_intros
            )
      qed (use arr_Set_pb_F arr_Set_hom_pa in auto)
    qed (use pb_F hom_pa in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
    from assms that set_𝔞 show ?thesis
      by 
        (
          cs_concl cs_shallow 
            cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
        )
  qed
qed (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
lemma (in 𝒵) ntcf_pointed_inv_is_ntcf'[cat_cs_intros]:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
    and "𝔉' = cf_id (cat_Set α)"
    and "𝔊' = Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)"
    and "𝔄' = cat_Set α"
    and "𝔅' = cat_Set α"
    and "α' = α"
  shows "ntcf_pointed_inv α 𝔞 : 𝔉' ↦⇩C⇩F 𝔊' : 𝔄' ↦↦⇩C⇘α'⇙ 𝔅'"
  using assms(1) unfolding assms(2-6) by (rule ntcf_pointed_inv_is_ntcf)
lemmas [cat_cs_intros] = 𝒵.ntcf_pointed_inv_is_ntcf'
lemma (in 𝒵) inv_ntcf_ntcf_pointed[cat_cs_simps]:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "inv_ntcf (ntcf_pointed α 𝔞) = ntcf_pointed_inv α 𝔞"
  by 
    (
      rule iso_ntcf_if_is_inverse(3)[symmetric], 
      rule is_iso_ntcfD(1)[OF ntcf_pointed_is_iso_ntcf[OF assms]],
      rule ntcf_pointed_inv_is_ntcf[OF assms],
      rule is_inverse_ntcf_pointed_inv_NTMap_app[OF assms]
    )
lemma (in 𝒵) inv_ntcf_ntcf_pointed_inv[cat_cs_simps]:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "inv_ntcf (ntcf_pointed_inv α 𝔞) = ntcf_pointed α 𝔞"
  by
    (
      rule iso_ntcf_if_is_inverse(4)[symmetric], 
      rule is_iso_ntcfD(1)[OF ntcf_pointed_is_iso_ntcf[OF assms]],
      rule ntcf_pointed_inv_is_ntcf[OF assms],
      rule is_inverse_ntcf_pointed_inv_NTMap_app[OF assms]
    )
lemma (in 𝒵) ntcf_pointed_inv_is_iso_ntcf:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
  shows "ntcf_pointed_inv α 𝔞 :
    cf_id (cat_Set α) ↦⇩C⇩F⇩.⇩i⇩s⇩o Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-) :
    cat_Set α ↦↦⇩C⇘α⇙ cat_Set α"
  by
    (
      rule iso_ntcf_if_is_inverse(2), 
      rule is_iso_ntcfD(1)[OF ntcf_pointed_is_iso_ntcf[OF assms]],
      rule ntcf_pointed_inv_is_ntcf[OF assms],
      rule is_inverse_ntcf_pointed_inv_NTMap_app[OF assms]
    )
lemma (in 𝒵) ntcf_pointed_inv_is_iso_ntcf'[cat_cs_intros]:
  assumes "𝔞 ∈⇩∘ cat_Set α⦇Obj⦈"
    and "𝔉' = cf_id (cat_Set α)"
    and "𝔊' = Hom⇩O⇩.⇩C⇘α⇙cat_Set α(set {𝔞},-)"
    and "𝔄' = cat_Set α"
    and "𝔅' = cat_Set α"
    and "α' = α"
  shows "ntcf_pointed_inv α 𝔞 : 𝔉' ↦⇩C⇩F⇩.⇩i⇩s⇩o 𝔊' : 𝔄' ↦↦⇩C⇘α'⇙ 𝔅'"
  using assms(1) unfolding assms(2-6) by (rule ntcf_pointed_inv_is_iso_ntcf)
lemmas [cat_cs_intros] = 𝒵.ntcf_pointed_inv_is_iso_ntcf'
text‹\newpage›
end