Theory CZH_ECAT_Yoneda

(* Copyright 2021 (C) Mihails Milehins *)

section‹Yoneda Lemma›
theory CZH_ECAT_Yoneda
  imports 
    CZH_ECAT_FUNCT
    CZH_ECAT_Hom
begin



subsection‹Yoneda map›


text‹
The Yoneda map is the bijection that is used in the statement of the
Yoneda Lemma, as presented, for example, in Chapter III-2 in 
cite‹"mac_lane_categories_2010"› or in subsection 1.15 
in cite‹"bodo_categories_1970"›.
›

definition Yoneda_map :: "V ⇒ V ⇒ V ⇒ V"
  where "Yoneda_map α 𝔎 r =
    (
      λψ∈∘these_ntcfs α (𝔎⦇HomDom⦈) (cat_Set α) HomO.C⇘α⇙𝔎⦇HomDom⦈(r,-) 𝔎.
        ψ⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇𝔎⦇HomDom⦈⦇CId⦈⦇r⦈⦈
    )"


text‹Elementary properties.›

mk_VLambda Yoneda_map_def
  |vsv Yoneda_map_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) Yoneda_map_def[where α=α and 𝔎=𝔉, unfolded cf_HomDom]
  |vdomain Yoneda_map_vdomain|
  |app Yoneda_map_app[unfolded these_ntcfs_iff]|

lemmas [cat_cs_simps] = is_functor.Yoneda_map_vdomain

lemmas Yoneda_map_app[cat_cs_simps] = 
  is_functor.Yoneda_map_app[unfolded these_ntcfs_iff]



subsection‹Yoneda component›


subsubsection‹Definition and elementary properties›


text‹
The Yoneda components are the components of the natural transformations
that appear in the statement of the Yoneda Lemma (e.g., see 
Chapter III-2 in cite‹"mac_lane_categories_2010"› or subsection 1.15 
in cite‹"bodo_categories_1970"›).
›

definition Yoneda_component :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "Yoneda_component 𝔎 r u d =
    [
      (λf∈∘Hom (𝔎⦇HomDom⦈) r d. 𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈),
      Hom (𝔎⦇HomDom⦈) r d,
      𝔎⦇ObjMap⦈⦇d⦈
    ]∘"


text‹Components.›

lemma (in is_functor) Yoneda_component_components: 
  shows "Yoneda_component 𝔉 r u d⦇ArrVal⦈ =
    (λf∈∘Hom 𝔄 r d. 𝔉⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈)"
    and "Yoneda_component 𝔉 r u d⦇ArrDom⦈ = Hom 𝔄 r d"
    and "Yoneda_component 𝔉 r u d⦇ArrCod⦈ = 𝔉⦇ObjMap⦈⦇d⦈"
  unfolding Yoneda_component_def arr_field_simps 
  by (simp_all add: nat_omega_simps cat_cs_simps)


subsubsection‹Arrow value›

mk_VLambda (in is_functor) Yoneda_component_components(1)
  |vsv Yoneda_component_ArrVal_vsv|
  |vdomain Yoneda_component_ArrVal_vdomain|
  |app Yoneda_component_ArrVal_app[unfolded in_Hom_iff]|

lemmas [cat_cs_simps] = is_functor.Yoneda_component_ArrVal_vdomain

lemmas Yoneda_component_ArrVal_app[cat_cs_simps] = 
  is_functor.Yoneda_component_ArrVal_app[unfolded in_Hom_iff]


subsubsection‹Yoneda component is an arrow in the category ‹Set››

lemma (in category) cat_Yoneda_component_is_arr:
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "r ∈∘ ℭ⦇Obj⦈"
    and "u ∈∘ 𝔎⦇ObjMap⦈⦇r⦈"
    and "d ∈∘ ℭ⦇Obj⦈"
  shows "Yoneda_component 𝔎 r u d : Hom ℭ r d ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇d⦈"   
proof-
  interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1)) 
  show ?thesis
  proof(intro cat_Set_is_arrI arr_SetI, unfold 𝔎.Yoneda_component_components)
    show "vfsequence (Yoneda_component 𝔎 r u d)" 
      unfolding Yoneda_component_def by simp
    show "vcard (Yoneda_component 𝔎 r u d) = 3ℕ"
      unfolding Yoneda_component_def by (simp add: nat_omega_simps)
    show "ℛ∘ (λf∈∘Hom ℭ r d. 𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈) ⊆∘ 𝔎⦇ObjMap⦈⦇d⦈"
    proof(rule vrange_VLambda_vsubset)
      fix f assume "f ∈∘ Hom ℭ r d"
      then have 𝔎f: "𝔎⦇ArrMap⦈⦇f⦈ : 𝔎⦇ObjMap⦈⦇r⦈ ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇d⦈" 
        by (auto simp: cat_cs_intros)
      note 𝔎f_simps = cat_Set_is_arrD[OF 𝔎f]
      interpret 𝔎f: arr_Set α ‹𝔎⦇ArrMap⦈⦇f⦈› by (rule 𝔎f_simps(1))          
      have "u ∈∘ 𝒟∘ (𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈)" 
        by (simp add: 𝔎f_simps assms cat_Set_cs_simps)
      with 𝔎f.arr_Set_ArrVal_vrange[unfolded 𝔎f_simps] show 
        "𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇u⦈ ∈∘ 𝔎⦇ObjMap⦈⦇d⦈"
        by (blast elim: 𝔎f.ArrVal.vsv_value)
    qed 
    from assms 𝔎.HomCod.cat_Obj_vsubset_Vset show "𝔎⦇ObjMap⦈⦇d⦈ ∈∘ Vset α"
      by (auto dest: 𝔎.cf_ObjMap_app_in_HomCod_Obj)
  qed (auto simp: assms cat_cs_intros)
qed

lemma (in category) cat_Yoneda_component_is_arr':
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α" 
    and "r ∈∘ ℭ⦇Obj⦈"
    and "u ∈∘ 𝔎⦇ObjMap⦈⦇r⦈"
    and "d ∈∘ ℭ⦇Obj⦈"
    and "s = Hom ℭ r d"
    and "t = 𝔎⦇ObjMap⦈⦇d⦈"
    and "𝔇 = cat_Set α"
  shows "Yoneda_component 𝔎 r u d : s ↦⇘𝔇⇙ t"   
  unfolding assms(5-7) using assms(1-4) by (rule cat_Yoneda_component_is_arr)

lemmas [cat_cs_intros] = category.cat_Yoneda_component_is_arr'[rotated 1]



subsection‹Yoneda arrow›


subsubsection‹Definition and elementary properties›


text‹
The Yoneda arrows are the natural transformations that 
appear in the statement of the Yoneda Lemma in Chapter III-2 in 
cite‹"mac_lane_categories_2010"› and subsection 1.15 
in cite‹"bodo_categories_1970"›.
›

definition Yoneda_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V" 
  where "Yoneda_arrow α 𝔎 r u =
    [
      (λd∈∘𝔎⦇HomDom⦈⦇Obj⦈. Yoneda_component 𝔎 r u d),
      HomO.C⇘α⇙𝔎⦇HomDom⦈(r,-),
      𝔎,
      𝔎⦇HomDom⦈,
      cat_Set α
    ]∘"


text‹Components.›

lemma (in is_functor) Yoneda_arrow_components:
  shows "Yoneda_arrow α 𝔉 r u⦇NTMap⦈ = 
    (λd∈∘𝔄⦇Obj⦈. Yoneda_component 𝔉 r u d)"
    and "Yoneda_arrow α 𝔉 r u⦇NTDom⦈ = HomO.C⇘α⇙𝔄(r,-)"
    and "Yoneda_arrow α 𝔉 r u⦇NTCod⦈ = 𝔉"
    and "Yoneda_arrow α 𝔉 r u⦇NTDGDom⦈ = 𝔄"
    and "Yoneda_arrow α 𝔉 r u⦇NTDGCod⦈ = cat_Set α"
  unfolding Yoneda_arrow_def nt_field_simps 
  by (simp_all add: nat_omega_simps cat_cs_simps)


subsubsection‹Natural transformation map›

mk_VLambda (in is_functor) Yoneda_arrow_components(1)
  |vsv Yoneda_arrow_NTMap_vsv|
  |vdomain Yoneda_arrow_NTMap_vdomain|
  |app Yoneda_arrow_NTMap_app|

lemmas [cat_cs_simps] = is_functor.Yoneda_arrow_NTMap_vdomain

lemmas Yoneda_arrow_NTMap_app[cat_cs_simps] = 
  is_functor.Yoneda_arrow_NTMap_app


subsubsection‹Yoneda arrow is a natural transformation›

lemma (in category) cat_Yoneda_arrow_is_ntcf:
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α" 
    and "r ∈∘ ℭ⦇Obj⦈" 
    and "u ∈∘ 𝔎⦇ObjMap⦈⦇r⦈"
  shows "Yoneda_arrow α 𝔎 r u : HomO.C⇘α⇙ℭ(r,-) ↦CF 𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α"
proof-

  interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1)) 
  note 𝔎ru = cat_Yoneda_component_is_arr[OF assms]
  let ?𝔎ru = ‹Yoneda_component 𝔎 r u›

  show ?thesis
  proof(intro is_ntcfI', unfold 𝔎.Yoneda_arrow_components)

    show "vfsequence (Yoneda_arrow α 𝔎 r u)"
      unfolding Yoneda_arrow_def by simp
    show "vcard (Yoneda_arrow α 𝔎 r u) = 5ℕ" 
      unfolding Yoneda_arrow_def by (simp add: nat_omega_simps)

    show
      "(λd∈∘ℭ⦇Obj⦈. ?𝔎ru d)⦇a⦈ :
        HomO.C⇘α⇙ℭ(r,-)⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇a⦈"
      if "a ∈∘ ℭ⦇Obj⦈" for a
      using that assms category_axioms
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_op_simps V_cs_simps 
            cs_intro: cat_cs_intros
        )
    show 
      "(λd∈∘ℭ⦇Obj⦈. ?𝔎ru d)⦇b⦈ ∘A⇘cat_Set α⇙ HomO.C⇘α⇙ℭ(r,-)⦇ArrMap⦈⦇f⦈ =
        𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ (λd∈∘ℭ⦇Obj⦈. ?𝔎ru d)⦇a⦈"
      if "f : a ↦⇘ℭ⇙ b" for a b f
    proof-

      note 𝔐a = 𝔎ru[OF cat_is_arrD(2)[OF that]]
      note 𝔐b = 𝔎ru[OF cat_is_arrD(3)[OF that]]

      from category_axioms assms that 𝔐b have b_f:
        "?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘ :
          Hom ℭ r a ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇b⦈"
        by
          (
            cs_concl cs_shallow 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      then have dom_lhs: 
        "𝒟∘ ((?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘)⦇ArrVal⦈) =
          Hom ℭ r a"
          by (cs_concl cs_shallow cs_simp: cat_cs_simps)
      from assms that 𝔐a have f_a: 
        "𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a :
          Hom ℭ r a ↦⇘cat_Set α⇙ 𝔎⦇ObjMap⦈⦇b⦈"
        by (cs_concl cs_shallow cs_intro: cat_cs_intros)
      then have dom_rhs: 
        "𝒟∘ ((𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a)⦇ArrVal⦈) = Hom ℭ r a"
        by (cs_concl cs_shallow cs_simp: cat_cs_simps)

      have [cat_cs_simps]:
        "?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘ =
          𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a"
      proof(rule arr_Set_eqI[of α])

        from b_f show arr_Set_b_f:
          "arr_Set α (?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘)"
          by (auto simp: cat_Set_is_arrD(1))
        interpret b_f: arr_Set α ‹?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘›
          by (rule arr_Set_b_f)
        from f_a show arr_Set_f_a:
          "arr_Set α (𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a)"
          by (auto simp: cat_Set_is_arrD(1))
        interpret f_a: arr_Set α ‹𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a›
          by (rule arr_Set_f_a)

        show 
          "(?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘)⦇ArrVal⦈ =
            (𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a)⦇ArrVal⦈"
        proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
          fix q assume "q : r ↦⇘ℭ⇙ a"
          from category_axioms assms that this 𝔐a 𝔐b show 
            "(?𝔎ru b ∘A⇘cat_Set α⇙ cf_hom ℭ [ℭ⦇CId⦈⦇r⦈, f]∘)⦇ArrVal⦈⦇q⦈ =
              (𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ ?𝔎ru a)⦇ArrVal⦈⦇q⦈"
            by
              (
                cs_concl cs_shallow
                  cs_simp: cat_cs_simps cat_op_simps
                  cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
              )
        qed (use arr_Set_b_f arr_Set_f_a in auto)

      qed (use b_f f_a in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+
  
      from that category_axioms assms 𝔐a 𝔐b show ?thesis
        by
          (
            cs_concl 
              cs_simp: V_cs_simps cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros
          )
    
    qed

  qed (auto simp: assms(2) cat_cs_intros)

qed



subsection‹Yoneda Lemma›

text‹
The following lemma is approximately equivalent to the Yoneda Lemma 
stated in subsection 1.15 in cite‹"bodo_categories_1970"› 
(the first two conclusions correspond to the statement of the 
Yoneda lemma in Chapter III-2 in cite‹"mac_lane_categories_2010"›).
›

lemma (in category) cat_Yoneda_Lemma: 
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α" and "r ∈∘ ℭ⦇Obj⦈"
  shows "v11 (Yoneda_map α 𝔎 r)" 
    and "ℛ∘ (Yoneda_map α 𝔎 r) = 𝔎⦇ObjMap⦈⦇r⦈"
    and "(Yoneda_map α 𝔎 r)¯∘ = (λu∈∘𝔎⦇ObjMap⦈⦇r⦈. Yoneda_arrow α 𝔎 r u)"
proof-

  interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1)) 

  from assms(2) 𝔎.HomCod.cat_Obj_vsubset_Vset 𝔎.cf_ObjMap_app_in_HomCod_Obj 
  have 𝔎r_in_Vset: "𝔎⦇ObjMap⦈⦇r⦈ ∈∘ Vset α"
    by auto

  show Ym: "v11 (Yoneda_map α 𝔎 r)"
  proof(intro vsv.vsv_valeq_v11I, unfold 𝔎.Yoneda_map_vdomain these_ntcfs_iff)

    fix 𝔐 𝔑
    assume prems: 
      "𝔐 : HomO.C⇘α⇙ℭ(r,-) ↦CF 𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α"
      "𝔑 : HomO.C⇘α⇙ℭ(r,-) ↦CF 𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α"
      "Yoneda_map α 𝔎 r⦇𝔐⦈ = Yoneda_map α 𝔎 r⦇𝔑⦈"
    from prems(3) have 𝔐r_𝔑r:
      "𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ = 𝔑⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈"
      unfolding 
        Yoneda_map_app[OF assms(1) prems(1)] 
        Yoneda_map_app[OF assms(1) prems(2)]
      by simp

    interpret 𝔐: is_ntcf α ℭ ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(r,-)› 𝔎 𝔐  
      by (rule prems(1))
    interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(r,-)› 𝔎 𝔑 
      by (rule prems(2))

    show "𝔐 = 𝔑"
    proof
      (
        rule ntcf_eqI[OF prems(1,2)]; 
        (rule refl)?;
        rule vsv_eqI, 
        unfold 𝔐.ntcf_NTMap_vdomain 𝔑.ntcf_NTMap_vdomain
      )

      fix d assume prems': "d ∈∘ ℭ⦇Obj⦈"

      note 𝔐d_simps = cat_Set_is_arrD[OF 𝔐.ntcf_NTMap_is_arr[OF prems']]
      interpret 𝔐d: arr_Set α ‹𝔐⦇NTMap⦈⦇d⦈› by (rule 𝔐d_simps(1))

      note 𝔑d_simps = cat_Set_is_arrD[OF 𝔑.ntcf_NTMap_is_arr[OF prems']]
      interpret 𝔑d: arr_Set α ‹𝔑⦇NTMap⦈⦇d⦈› by (rule 𝔑d_simps(1))

      show "𝔐⦇NTMap⦈⦇d⦈ = 𝔑⦇NTMap⦈⦇d⦈"
      proof(rule arr_Set_eqI[of α])
        show "𝔐⦇NTMap⦈⦇d⦈⦇ArrVal⦈ = 𝔑⦇NTMap⦈⦇d⦈⦇ArrVal⦈"
        proof
          (
            rule vsv_eqI, 
            unfold 
              𝔑d.arr_Set_ArrVal_vdomain 
              𝔐d.arr_Set_ArrVal_vdomain  
              𝔐d_simps
              𝔑d_simps
          )
          fix f assume prems'': "f ∈∘ HomO.C⇘α⇙ℭ(r,-)⦇ObjMap⦈⦇d⦈"
          from prems'' prems' category_axioms assms(2) have f: "f : r ↦⇘ℭ⇙ d"
            by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_op_intros)
          from 𝔐.ntcf_Comp_commute[OF f] have 
            "(
              𝔐⦇NTMap⦈⦇d⦈ ∘A⇘cat_Set α⇙ HomO.C⇘α⇙ℭ(r,-)⦇ArrMap⦈⦇f⦈
            )⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ =
              (𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ 𝔐⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈"
            by simp
          from this category_axioms assms(2) f prems prems' have 𝔐df:
            "𝔐⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈ =
              𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈⦈"
            by 
              (
                cs_prems cs_shallow
                  cs_simp: cat_cs_simps cat_op_simps 
                  cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
              )
          from 𝔑.ntcf_Comp_commute[OF f] have
            "(
              𝔑⦇NTMap⦈⦇d⦈ ∘A⇘cat_Set α⇙ 
              HomO.C⇘α⇙ℭ(r,-)⦇ArrMap⦈⦇f⦈
            )⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ = 
              (𝔎⦇ArrMap⦈⦇f⦈ ∘A⇘cat_Set α⇙ 𝔑⦇NTMap⦈⦇r⦈)⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈"
            by simp
          from this category_axioms assms(2) f prems prems' have 𝔑df:
            "𝔑⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈ =
              𝔎⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈⦈"
            by
              (
                cs_prems cs_shallow
                  cs_simp: cat_cs_simps cat_op_simps 
                  cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
              )
          show "𝔐⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈ = 𝔑⦇NTMap⦈⦇d⦈⦇ArrVal⦈⦇f⦈"
            unfolding 𝔐df 𝔑df 𝔐r_𝔑r by simp
        qed auto

      qed (simp_all add: 𝔐d_simps 𝔑d_simps)

    qed auto

  qed (auto simp: Yoneda_map_vsv)

  interpret Ym: v11 ‹Yoneda_map α 𝔎 r› by (rule Ym)

  have YY: "Yoneda_map α 𝔎 r⦇Yoneda_arrow α 𝔎 r a⦈ = a" 
    if "a ∈∘ 𝔎⦇ObjMap⦈⦇r⦈" for a
  proof-
    note cat_Yoneda_arrow_is_ntcf[OF assms that]
    moreover with assms have Ya: "Yoneda_arrow α 𝔎 r a ∈∘ 𝒟∘ (Yoneda_map α 𝔎 r)" 
      by 
        (
          cs_concl cs_shallow 
            cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
        )
    ultimately show "Yoneda_map α 𝔎 r⦇Yoneda_arrow α 𝔎 r a⦈ = a"
      using assms that 𝔎r_in_Vset
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed        

  show [simp]: "ℛ∘ (Yoneda_map α 𝔎 r) = 𝔎⦇ObjMap⦈⦇r⦈"
  proof(intro vsubset_antisym)

    show "ℛ∘ (Yoneda_map α 𝔎 r) ⊆∘ 𝔎⦇ObjMap⦈⦇r⦈"
      unfolding Yoneda_map_def
    proof(intro vrange_VLambda_vsubset, unfold these_ntcfs_iff 𝔎.cf_HomDom)
      fix 𝔐 assume prems: "𝔐 : HomO.C⇘α⇙ℭ(r,-) ↦CF 𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α"
      then interpret 𝔐: is_ntcf α ℭ ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(r,-)› 𝔎 𝔐 .
      note 𝔐r_simps = cat_Set_is_arrD[OF 𝔐.ntcf_NTMap_is_arr[OF assms(2)]]
      interpret 𝔐r: arr_Set α ‹𝔐⦇NTMap⦈⦇r⦈› by (rule 𝔐r_simps(1))
      from prems category_axioms assms(2) have 
        "ℭ⦇CId⦈⦇r⦈ ∈∘ 𝒟∘ (𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈)"
        unfolding 𝔐r.arr_Set_ArrVal_vdomain 𝔐r_simps
        by 
          (
            cs_concl cs_shallow 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
          )
      then have "𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ ∈∘ ℛ∘ (𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈)"
        by (blast elim: 𝔐r.ArrVal.vsv_value)
      then show "𝔐⦇NTMap⦈⦇r⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇r⦈⦈ ∈∘ 𝔎⦇ObjMap⦈⦇r⦈"
        by (auto simp: 𝔐r_simps dest!: vsubsetD[OF 𝔐r.arr_Set_ArrVal_vrange])
    qed
    
    show "𝔎⦇ObjMap⦈⦇r⦈ ⊆∘ ℛ∘ (Yoneda_map α 𝔎 r)"
    proof(intro vsubsetI)
      fix u assume prems: "u ∈∘ 𝔎⦇ObjMap⦈⦇r⦈"
      from cat_Yoneda_arrow_is_ntcf[OF assms prems] have 
        "Yoneda_arrow α 𝔎 r u ∈∘ 𝒟∘ (Yoneda_map α 𝔎 r)" 
        by 
          (
            cs_concl cs_shallow 
              cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
          )
      with YY[OF prems] show "u ∈∘ ℛ∘ (Yoneda_map α 𝔎 r)" 
        by (force dest!: vdomain_atD)
    qed

  qed

  show "(Yoneda_map α 𝔎 r)¯∘ = (λu∈∘𝔎⦇ObjMap⦈⦇r⦈. Yoneda_arrow α 𝔎 r u)"
  proof(rule vsv_eqI, unfold vdomain_vconverse vdomain_VLambda)
    from Ym show "vsv ((Yoneda_map α 𝔎 r)¯∘)" by auto
    show "(Yoneda_map α 𝔎 r)¯∘⦇a⦈ = (λu∈∘𝔎⦇ObjMap⦈⦇r⦈. Yoneda_arrow α 𝔎 r u)⦇a⦈"
      if "a ∈∘ ℛ∘ (Yoneda_map α 𝔎 r)" for a
    proof-
      from that have a: "a ∈∘ 𝔎⦇ObjMap⦈⦇r⦈" by simp
      note Ya = cat_Yoneda_arrow_is_ntcf[OF assms a]
      then have "Yoneda_arrow α 𝔎 r a ∈∘ 𝒟∘ (Yoneda_map α 𝔎 r)"
        by 
          (
            cs_concl cs_shallow
              cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros
          )
      with Ya YY[OF a] a show ?thesis
        by 
          (
            intro Ym.v11_vconverse_app[
              unfolded 𝔎.Yoneda_map_vdomain these_ntcfs_iff
              ]
          )
          (simp_all add: these_ntcfs_iff cat_cs_simps)
    qed
  qed auto

qed



subsection‹Inverse of the Yoneda map›

lemma (in category) inv_Yoneda_map_v11: 
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α" and "r ∈∘ ℭ⦇Obj⦈"
  shows "v11 ((Yoneda_map α 𝔎 r)¯∘)"
  using cat_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)

lemma (in category) inv_Yoneda_map_vdomain: 
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α" and "r ∈∘ ℭ⦇Obj⦈"
  shows "𝒟∘ ((Yoneda_map α 𝔎 r)¯∘) = 𝔎⦇ObjMap⦈⦇r⦈"
  unfolding cat_Yoneda_Lemma(3)[OF assms] by simp

lemmas [cat_cs_simps] = category.inv_Yoneda_map_vdomain

lemma (in category) inv_Yoneda_map_app: 
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α" and "r ∈∘ ℭ⦇Obj⦈" and "u ∈∘ 𝔎⦇ObjMap⦈⦇r⦈"
  shows "(Yoneda_map α 𝔎 r)¯∘⦇u⦈ = Yoneda_arrow α 𝔎 r u"
  using assms(3) unfolding cat_Yoneda_Lemma(3)[OF assms(1,2)] by simp

lemmas [cat_cs_simps] = category.inv_Yoneda_map_app

lemma (in category) inv_Yoneda_map_vrange: 
  assumes "𝔎 : ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "ℛ∘ ((Yoneda_map α 𝔎 r)¯∘) =
    these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(r,-) 𝔎"
proof-
  interpret 𝔎: is_functor α ℭ ‹cat_Set α› 𝔎 by (rule assms(1)) 
  show ?thesis unfolding Yoneda_map_def by (simp add: cat_cs_simps)
qed



subsection‹
Component of a composition of a ‹Hom›-natural transformation 
with natural transformations
›


subsubsection‹Definition and elementary properties›


text‹
The following definition is merely a technical generalization
that is used in the context of the description of the 
composition of a ‹Hom›-natural transformation with a natural transformation
later in this section
(also see subsection 1.15 in cite‹"bodo_categories_1970"›).
›

definition ntcf_Hom_component :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_Hom_component φ ψ a b =
    [
      (
        λf∈∘Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈).
          ψ⦇NTMap⦈⦇b⦈ ∘A⇘ψ⦇NTDGCod⦈⇙ f ∘A⇘ψ⦇NTDGCod⦈⇙ φ⦇NTMap⦈⦇a⦈
      ),
      Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈),
      Hom (φ⦇NTDGCod⦈) (φ⦇NTDom⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTCod⦈⦇ObjMap⦈⦇b⦈)
    ]∘"


text‹Components.›

lemma ntcf_Hom_component_components: 
  shows "ntcf_Hom_component φ ψ a b⦇ArrVal⦈ =
    (
      λf∈∘Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈).
        ψ⦇NTMap⦈⦇b⦈ ∘A⇘ψ⦇NTDGCod⦈⇙ f ∘A⇘ψ⦇NTDGCod⦈⇙ φ⦇NTMap⦈⦇a⦈
    )"
    and "ntcf_Hom_component φ ψ a b⦇ArrDom⦈ =
      Hom (φ⦇NTDGCod⦈) (φ⦇NTCod⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTDom⦈⦇ObjMap⦈⦇b⦈)"
    and "ntcf_Hom_component φ ψ a b⦇ArrCod⦈ =
      Hom (φ⦇NTDGCod⦈) (φ⦇NTDom⦈⦇ObjMap⦈⦇a⦈) (ψ⦇NTCod⦈⦇ObjMap⦈⦇b⦈)"
  unfolding ntcf_Hom_component_def arr_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsection‹Arrow value›

mk_VLambda ntcf_Hom_component_components(1)
  |vsv ntcf_Hom_component_ArrVal_vsv[intro]|

context
  fixes α φ ψ 𝔉 𝔊 𝔉' 𝔊' 𝔄 𝔅 ℭ
  assumes φ: "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and ψ: "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
begin

interpretation φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule φ)
interpretation ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule ψ)

mk_VLambda 
  ntcf_Hom_component_components(1)
    [
      of φ ψ, 
      unfolded 
        φ.ntcf_NTDom ψ.ntcf_NTDom 
        φ.ntcf_NTCod ψ.ntcf_NTCod 
        φ.ntcf_NTDGDom ψ.ntcf_NTDGDom
        φ.ntcf_NTDGCod ψ.ntcf_NTDGCod
    ]
  |vdomain ntcf_Hom_component_ArrVal_vdomain|
  |app ntcf_Hom_component_ArrVal_app[unfolded in_Hom_iff]|

lemmas [cat_cs_simps] = 
  ntcf_Hom_component_ArrVal_vdomain
  ntcf_Hom_component_ArrVal_app

lemma ntcf_Hom_component_ArrVal_vrange:
  assumes "a ∈∘ 𝔄⦇Obj⦈" and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ℛ∘ (ntcf_Hom_component φ ψ a b⦇ArrVal⦈) ⊆∘
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold ntcf_Hom_component_ArrVal_vdomain in_Hom_iff
  )
  fix f assume "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
  with assms φ ψ show 
    "ntcf_Hom_component φ ψ a b⦇ArrVal⦈⦇f⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔊'⦇ObjMap⦈⦇b⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed (rule ntcf_Hom_component_ArrVal_vsv)

end


subsubsection‹Arrow domain and codomain›

context
  fixes α φ ψ 𝔉 𝔊 𝔉' 𝔊' 𝔄 𝔅 ℭ
  assumes φ: "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and ψ: "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
begin

interpretation φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule φ)
interpretation ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule ψ)

lemma ntcf_Hom_component_ArrDom[cat_cs_simps]:
  "ntcf_Hom_component φ ψ a b⦇ArrDom⦈ = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
  unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)

lemma ntcf_Hom_component_ArrCod[cat_cs_simps]:
  "ntcf_Hom_component φ ψ a b⦇ArrCod⦈ = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
  unfolding ntcf_Hom_component_components by (simp add: cat_cs_simps)

end


subsubsection‹
Component of a composition of a ‹Hom›-natural transformation 
with natural transformations is an arrow in the category ‹Set›
›

lemma (in category) cat_ntcf_Hom_component_is_arr:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ntcf_Hom_component φ ψ a b :
      Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
proof-
  
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))

  from assms have a: "a ∈∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp

  show ?thesis
  proof(intro cat_Set_is_arrI arr_SetI)
    show "vfsequence (ntcf_Hom_component φ ψ a b)"
      unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
    show "vcard (ntcf_Hom_component φ ψ a b) = 3ℕ"
      unfolding ntcf_Hom_component_def by (simp add: nat_omega_simps)
    from assms ntcf_Hom_component_ArrVal_vrange[OF assms(1,2) a assms(4)] show 
      "ℛ∘ (ntcf_Hom_component φ ψ a b⦇ArrVal⦈) ⊆∘ 
        ntcf_Hom_component φ ψ a b⦇ArrCod⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    from assms(1,2,4) a show "ntcf_Hom_component φ ψ a b⦇ArrDom⦈ ∈∘ Vset α"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(1,2,4) a show "ntcf_Hom_component φ ψ a b⦇ArrCod⦈ ∈∘ Vset α"
      by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (use assms in ‹auto simp: ntcf_Hom_component_components cat_cs_simps›)

qed

lemma (in category) cat_ntcf_Hom_component_is_arr':
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "𝔄' = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
    and "𝔅' = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔊'⦇ObjMap⦈⦇b⦈)"
    and "ℭ' = cat_Set α"
  shows "ntcf_Hom_component φ ψ a b : 𝔄' ↦⇘ℭ'⇙ 𝔅'"
  using assms(1-4) unfolding assms(5-7) by (rule cat_ntcf_Hom_component_is_arr)
  
lemmas [cat_cs_intros] = category.cat_ntcf_Hom_component_is_arr'


subsubsection‹
Naturality of the components of a composition of 
a ‹Hom›-natural transformation with natural transformations
›

lemma (in category) cat_ntcf_Hom_component_nat:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "g : a ↦⇘op_cat 𝔄⇙ a'"
    and "f : b ↦⇘𝔅⇙ b'" 
  shows
    "ntcf_Hom_component φ ψ a' b' ∘A⇘cat_Set α⇙
     cf_hom ℭ [𝔊⦇ArrMap⦈⦇g⦈, 𝔉'⦇ArrMap⦈⦇f⦈]∘ =
      cf_hom ℭ [𝔉⦇ArrMap⦈⦇g⦈, 𝔊'⦇ArrMap⦈⦇f⦈]∘ ∘A⇘cat_Set α⇙
      ntcf_Hom_component φ ψ a b"
proof-

  let ?Y_ab = ‹ntcf_Hom_component φ ψ a b›
    and ?Y_a'b' = ‹ntcf_Hom_component φ ψ a' b'›
    and ?𝔊g = ‹𝔊⦇ArrMap⦈⦇g⦈›
    and ?𝔉'f = ‹𝔉'⦇ArrMap⦈⦇f⦈›
    and ?𝔉g = ‹𝔉⦇ArrMap⦈⦇g⦈›
    and ?𝔊'f = ‹𝔊'⦇ArrMap⦈⦇f⦈›
    and ?𝔊a = ‹𝔊⦇ObjMap⦈⦇a⦈›
    and ?𝔉'b = ‹𝔉'⦇ObjMap⦈⦇b⦈›
    and ?𝔉a' = ‹𝔉⦇ObjMap⦈⦇a'⦈›
    and ?𝔊'b' = ‹𝔊'⦇ObjMap⦈⦇b'⦈›

  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)

  from assms(3) have g: "g : a' ↦⇘𝔄⇙ a" unfolding cat_op_simps by simp

  from Set.category_axioms category_axioms assms g have a'b_Gg𝔉'f:
    "?Y_a'b' ∘A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]∘ :
      Hom ℭ ?𝔊a ?𝔉'b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉a' ?𝔊'b'"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_lhs: 
    "𝒟∘ ((?Y_a'b' ∘A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]∘)⦇ArrVal⦈) = 
      Hom ℭ ?𝔊a ?𝔉'b"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from Set.category_axioms category_axioms assms g have 𝔉g𝔊'f_ab: 
    "cf_hom ℭ [?𝔉g, ?𝔊'f]∘ ∘A⇘cat_Set α⇙ ?Y_ab : 
      Hom ℭ ?𝔊a ?𝔉'b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉a' ?𝔊'b'"
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
      )
  then have dom_rhs: 
    "𝒟∘ ((cf_hom ℭ [?𝔉g, ?𝔊'f]∘ ∘A⇘cat_Set α⇙ ?Y_ab)⦇ArrVal⦈) =
      Hom ℭ ?𝔊a ?𝔉'b"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from a'b_Gg𝔉'f show arr_Set_a'b_Gg𝔉'f:
      "arr_Set α (?Y_a'b' ∘A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]∘)"
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔉g𝔊'f_ab show arr_Set_𝔉g𝔊'f_ab: 
      "arr_Set α (cf_hom ℭ [?𝔉g, ?𝔊'f]∘ ∘A⇘cat_Set α⇙ ?Y_ab)"
      by (auto dest: cat_Set_is_arrD(1))
    show 
      "(?Y_a'b' ∘A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]∘)⦇ArrVal⦈ =
        (cf_hom ℭ [?𝔉g, ?𝔊'f]∘ ∘A⇘cat_Set α⇙ ?Y_ab)⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume prems: "h : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
      from assms(1,2) g have [cat_cs_simps]:
        "ψ⦇NTMap⦈⦇b'⦈ ∘A⇘ℭ⇙ (?𝔉'f ∘A⇘ℭ⇙ (h ∘A⇘ℭ⇙ (?𝔊g ∘A⇘ℭ⇙ φ⦇NTMap⦈⦇a'⦈))) =
          ψ⦇NTMap⦈⦇b'⦈ ∘A⇘ℭ⇙ (?𝔉'f ∘A⇘ℭ⇙ (h ∘A⇘ℭ⇙ (φ⦇NTMap⦈⦇a⦈ ∘A⇘ℭ⇙ ?𝔉g)))"
        by 
          (
            cs_concl cs_shallow 
              cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros
          )
      also from assms(1,2,4) prems g have "… =
        (((ψ⦇NTMap⦈⦇b'⦈ ∘A⇘ℭ⇙ ?𝔉'f) ∘A⇘ℭ⇙ h) ∘A⇘ℭ⇙ φ⦇NTMap⦈⦇a⦈) ∘A⇘ℭ⇙ ?𝔉g"
        by (cs_concl cs_shallow cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) 
      also from assms(1,2,4) have "… =
        (((?𝔊'f ∘A⇘ℭ⇙ ψ⦇NTMap⦈⦇b⦈) ∘A⇘ℭ⇙ h) ∘A⇘ℭ⇙ φ⦇NTMap⦈⦇a⦈) ∘A⇘ℭ⇙ ?𝔉g"
        by 
          (
            cs_concl cs_shallow 
              cs_simp: is_ntcf.ntcf_Comp_commute cs_intro: cat_cs_intros
          )
      also from assms(1,2,4) prems g have "… =
        ?𝔊'f ∘A⇘ℭ⇙ (ψ⦇NTMap⦈⦇b⦈ ∘A⇘ℭ⇙ (h ∘A⇘ℭ⇙ (φ⦇NTMap⦈⦇a⦈ ∘A⇘ℭ⇙ ?𝔉g)))"
        by (cs_concl cs_simp: cat_Comp_assoc cs_intro: cat_cs_intros) (*slow*)
      finally have nat:
        "ψ⦇NTMap⦈⦇b'⦈ ∘A⇘ℭ⇙ (?𝔉'f ∘A⇘ℭ⇙ (h ∘A⇘ℭ⇙ (?𝔊g ∘A⇘ℭ⇙ φ⦇NTMap⦈⦇a'⦈))) =
          ?𝔊'f ∘A⇘ℭ⇙ (ψ⦇NTMap⦈⦇b⦈ ∘A⇘ℭ⇙ (h ∘A⇘ℭ⇙ (φ⦇NTMap⦈⦇a⦈ ∘A⇘ℭ⇙ ?𝔉g)))".
      from prems Set.category_axioms category_axioms assms(1,2,4) g show 
        "(?Y_a'b' ∘A⇘cat_Set α⇙ cf_hom ℭ [?𝔊g, ?𝔉'f]∘)⦇ArrVal⦈⦇h⦈ =
          (cf_hom ℭ [?𝔉g, ?𝔊'f]∘ ∘A⇘cat_Set α⇙ ?Y_ab)⦇ArrVal⦈⦇h⦈"
        by (*slow*)
          (
            cs_concl 
              cs_simp: nat cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed (use arr_Set_a'b_Gg𝔉'f arr_Set_𝔉g𝔊'f_ab in auto)

  qed (use a'b_Gg𝔉'f 𝔉g𝔊'f_ab in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+

qed


subsubsection‹
Composition of the components of a composition of a ‹Hom›-natural 
transformation with natural transformations
›

lemma (in category) cat_ntcf_Hom_component_Comp:
  assumes "φ' : 𝔊 ↦CF ℌ : 𝔄 ↦↦C⇘α⇙ ℭ" 
    and "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ψ' : 𝔊' ↦CF ℌ' : 𝔅 ↦↦C⇘α⇙ ℭ" 
    and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ntcf_Hom_component φ ψ' a b ∘A⇘cat_Set α⇙ ntcf_Hom_component φ' ψ a b =
      ntcf_Hom_component (φ' ∙NTCF φ) (ψ' ∙NTCF ψ) a b"
    (is ‹?φψ' ∘A⇘cat_Set α⇙ ?φ'ψ = ?φ'φψ'ψ›)
proof-

  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)

  from assms Set.category_axioms category_axioms have φψ'_φ'ψ: 
    "?φψ' ∘A⇘cat_Set α⇙ ?φ'ψ :
      Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (ℌ'⦇ObjMap⦈⦇b⦈)"    
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
  then have dom_lhs: 
    "𝒟∘ ((?φψ' ∘A⇘cat_Set α⇙ ?φ'ψ)⦇ArrVal⦈) = 
      Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from assms Set.category_axioms category_axioms have φ'φψ'ψ: 
    "?φ'φψ'ψ :
      Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (ℌ'⦇ObjMap⦈⦇b⦈)"    
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_op_intros)
  then have dom_rhs: 
    "𝒟∘ (?φ'φψ'ψ⦇ArrVal⦈) = Hom ℭ (ℌ⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)" 
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from φψ'_φ'ψ show arr_Set_φψ'_φ'ψ: "arr_Set α (?φψ' ∘A⇘cat_Set α⇙ ?φ'ψ)"
      by (auto dest: cat_Set_is_arrD(1))
    from φ'φψ'ψ show arr_Set_φ'φψ'ψ: "arr_Set α ?φ'φψ'ψ"
      by (auto dest: cat_Set_is_arrD(1))
    show "(?φψ' ∘A⇘cat_Set α⇙ ?φ'ψ)⦇ArrVal⦈ = ?φ'φψ'ψ⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix f assume "f : ℌ⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
      with category_axioms assms Set.category_axioms show 
        "(?φψ' ∘A⇘cat_Set α⇙ ?φ'ψ)⦇ArrVal⦈⦇f⦈ = ?φ'φψ'ψ⦇ArrVal⦈⦇f⦈"
        by 
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed (use arr_Set_φ'φψ'ψ arr_Set_φψ'_φ'ψ in auto)
    
  qed (use φψ'_φ'ψ φ'φψ'ψ in ‹cs_concl cs_simp: cat_cs_simps›)+

qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_Comp


subsubsection‹
Component of a composition of ‹Hom›-natural 
transformation with the identity natural transformations
›

lemma (in category) cat_ntcf_Hom_component_ntcf_id:
  assumes "𝔉 : 𝔄 ↦↦C⇘α⇙ ℭ" 
    and "𝔉': 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ 𝔄⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows 
    "ntcf_Hom_component (ntcf_id 𝔉) (ntcf_id 𝔉') a b =
      cat_Set α⦇CId⦈⦇Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)⦈"
    (is ‹?𝔉𝔉' = cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈›)
proof-

  interpret 𝔉: is_functor α 𝔄 ℭ 𝔉 by (rule assms(1))
  interpret 𝔉': is_functor α 𝔅 ℭ 𝔉' by (rule assms(2))
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)

  from assms Set.category_axioms category_axioms have 𝔉𝔉': 
    "?𝔉𝔉' :
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"    
    by (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  then have dom_lhs: "𝒟∘ (?𝔉𝔉'⦇ArrVal⦈) = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
    by (cs_concl cs_simp: cat_cs_simps)

  from category_axioms assms Set.category_axioms have 𝔉a𝔉'b: 
    "cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈ :
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
    by 
      (
        cs_concl 
          cs_simp: cat_Set_cs_simps cat_Set_components(1) 
          cs_intro: cat_cs_intros
      )
  then have dom_rhs: 
    "𝒟∘ (cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈⦇ArrVal⦈) = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (𝔉'⦇ObjMap⦈⦇b⦈)"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from 𝔉𝔉' show arr_Set_𝔉ψ: "arr_Set α ?𝔉𝔉'" 
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔉a𝔉'b show arr_Set_𝔉a𝔉'b: "arr_Set α (cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈)" 
      by (auto dest: cat_Set_is_arrD(1))
    show "?𝔉𝔉'⦇ArrVal⦈ = cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)  
      fix f assume "f : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ 𝔉'⦇ObjMap⦈⦇b⦈"
      with category_axioms Set.category_axioms assms show 
        "?𝔉𝔉'⦇ArrVal⦈⦇f⦈ = cat_Set α⦇CId⦈⦇?𝔉a𝔉'b⦈⦇ArrVal⦈⦇f⦈"
        by
          (
            cs_concl
              cs_simp: cat_cs_simps cat_Set_components(1)
              cs_intro: cat_cs_intros
          )
    qed (use arr_Set_𝔉a𝔉'b in auto)
      
  qed (use 𝔉𝔉' 𝔉a𝔉'b in ‹cs_concl cs_simp: cat_cs_simps›)+

qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_component_ntcf_id



subsection‹
Component of a composition of a ‹Hom›-natural transformation 
with a natural transformation
›


subsubsection‹Definition and elementary properties›

definition ntcf_lcomp_Hom_component :: "V ⇒ V ⇒ V ⇒ V"
  where "ntcf_lcomp_Hom_component φ a b =
    ntcf_Hom_component φ (ntcf_id (cf_id (φ⦇NTDGCod⦈))) a b"

definition ntcf_rcomp_Hom_component :: "V ⇒ V ⇒ V ⇒ V"
  where "ntcf_rcomp_Hom_component ψ a b =
    ntcf_Hom_component (ntcf_id (cf_id (ψ⦇NTDGCod⦈))) ψ a b"


subsubsection‹Arrow value›

lemma ntcf_lcomp_Hom_component_ArrVal_vsv: 
  "vsv (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈)"
  unfolding ntcf_lcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)

lemma ntcf_rcomp_Hom_component_ArrVal_vsv: 
  "vsv (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈)"
  unfolding ntcf_rcomp_Hom_component_def by (rule ntcf_Hom_component_ArrVal_vsv)

lemma ntcf_lcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]: 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "b ∈∘ ℭ⦇Obj⦈"
  shows "𝒟∘ (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈) = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  show ?thesis
    using assms
    unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrVal_vdomain[cat_cs_simps]: 
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "𝒟∘ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) = Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈)"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  show ?thesis
    using assms
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_component_ArrVal_app[cat_cs_simps]: 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
    and "h : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ b"
  shows "ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈⦇h⦈ = h ∘A⇘ℭ⇙ φ⦇NTMap⦈⦇a⦈"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  show ?thesis
    using assms
    unfolding cat_op_simps ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrVal_app[cat_cs_simps]: 
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "h : a ↦⇘ℭ⇙ 𝔉⦇ObjMap⦈⦇b⦈"
  shows "ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈⦇h⦈ = ψ⦇NTMap⦈⦇b⦈ ∘A⇘ℭ⇙ h"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  show ?thesis
    using assms
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_component_ArrVal_vrange: 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "ℛ∘ (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈) ⊆∘ Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms(2) have a: "a ∈∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "ℛ∘ (ntcf_lcomp_Hom_component φ a b⦇ArrVal⦈) ⊆∘
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (cf_id ℭ⦇ObjMap⦈⦇b⦈)"
    by 
      (
        unfold cat_op_simps ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod, 
        intro ntcf_Hom_component_ArrVal_vrange
      ) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+
  from this assms(3) show ?thesis by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed

lemma ntcf_rcomp_Hom_component_ArrVal_vrange: 
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "ℛ∘ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) ⊆∘ Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms(2) have a: "a ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "ℛ∘ (ntcf_rcomp_Hom_component ψ a b⦇ArrVal⦈) ⊆∘
      Hom ℭ (cf_id ℭ⦇ObjMap⦈⦇a⦈) (𝔊⦇ObjMap⦈⦇b⦈)"
    by 
      (
        unfold ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod, 
        intro ntcf_Hom_component_ArrVal_vrange
      ) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from this a show ?thesis by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed


subsubsection‹Arrow domain and codomain›

lemma ntcf_lcomp_Hom_component_ArrDom[cat_cs_simps]:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "b ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_lcomp_Hom_component φ a b⦇ArrDom⦈ = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrDom[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "ntcf_rcomp_Hom_component ψ a b⦇ArrDom⦈ = Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈)"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms show ?thesis
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_component_ArrCod[cat_cs_simps]:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "b ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_lcomp_Hom_component φ a b⦇ArrCod⦈ = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_component_ArrCod[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ" and "a ∈∘ op_cat ℭ⦇Obj⦈"
  shows "ntcf_rcomp_Hom_component ψ a b⦇ArrCod⦈ = Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)" 
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms show ?thesis
    unfolding cat_op_simps ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed


subsubsection‹
Component of a composition of a ‹Hom›-natural transformation 
with a natural transformation is an arrow in the category ‹Set›
›

lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_lcomp_Hom_component φ a b :
    Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms have a: "a ∈∘ 𝔄⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "ntcf_lcomp_Hom_component φ a b :
      Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) (cf_id ℭ⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ 
      Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) (cf_id ℭ⦇ObjMap⦈⦇b⦈)"
    unfolding ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
    by (intro cat_ntcf_Hom_component_is_arr)
      (cs_concl cs_intro: cat_cs_intros cat_op_intros)+
  from this assms(1,3) a show ?thesis 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed

lemma (in category) cat_ntcf_lcomp_Hom_component_is_arr':
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
    and "𝔄' = Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b"
    and "𝔅' = Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
    and "ℭ' = cat_Set α"
  shows "ntcf_lcomp_Hom_component φ a b : 𝔄' ↦⇘ℭ'⇙ 𝔅'"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule cat_ntcf_lcomp_Hom_component_is_arr)

lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_component_is_arr'

lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat ℭ⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "ntcf_rcomp_Hom_component ψ a b :
    Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙ Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms have a: "a ∈∘ ℭ⦇Obj⦈" unfolding cat_op_simps by simp
  from assms(1,3) a have 
    "ntcf_rcomp_Hom_component ψ a b :
      Hom ℭ (cf_id ℭ⦇ObjMap⦈⦇a⦈) (𝔉⦇ObjMap⦈⦇b⦈) ↦⇘cat_Set α⇙
      Hom ℭ (cf_id ℭ⦇ObjMap⦈⦇a⦈) (𝔊⦇ObjMap⦈⦇b⦈)"
    unfolding ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (intro cat_ntcf_Hom_component_is_arr)
      (cs_concl cs_intro: cat_cs_intros cat_op_intros)
  from this assms(1,3) a show ?thesis 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps)
qed

lemma (in category) cat_ntcf_rcomp_Hom_component_is_arr':
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat ℭ⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "𝔄' = Hom ℭ a (𝔉⦇ObjMap⦈⦇b⦈)"
    and "𝔅' = Hom ℭ a (𝔊⦇ObjMap⦈⦇b⦈)"
    and "ℭ' = cat_Set α"
  shows "ntcf_rcomp_Hom_component ψ a b : 𝔄' ↦⇘ℭ'⇙ 𝔅'"
  using assms(1-3) 
  unfolding assms(4-6)
  by (rule cat_ntcf_rcomp_Hom_component_is_arr)

lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_component_is_arr'



subsection‹
Composition of a ‹Hom›-natural transformation with two natural transformations
›


subsubsection‹Definition and elementary properties›


text‹See subsection 1.15 in cite‹"bodo_categories_1970"›.›

definition ntcf_Hom :: "V ⇒ V ⇒ V ⇒ V" (‹HomA.Cı'(/_-,_-/')›)
  where "HomA.C⇘α⇙(φ-,ψ-) =
    [
      (
        λab∈∘(op_cat (φ⦇NTDGDom⦈) ×C ψ⦇NTDGDom⦈)⦇Obj⦈.
          ntcf_Hom_component φ ψ (vpfst ab) (vpsnd ab)
      ),
      HomO.C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTCod⦈-,ψ⦇NTDom⦈-),
      HomO.C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTDom⦈-,ψ⦇NTCod⦈-),
      op_cat (φ⦇NTDGDom⦈) ×C ψ⦇NTDGDom⦈,
      cat_Set α
    ]∘"


text‹Components.›

lemma ntcf_Hom_components:
  shows "HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈ =
    (
      λab∈∘(op_cat (φ⦇NTDGDom⦈) ×C ψ⦇NTDGDom⦈)⦇Obj⦈.
        ntcf_Hom_component φ ψ (vpfst ab) (vpsnd ab)
    )"
    and "HomA.C⇘α⇙(φ-,ψ-)⦇NTDom⦈ =
      HomO.C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTCod⦈-,ψ⦇NTDom⦈-)"
    and "HomA.C⇘α⇙(φ-,ψ-)⦇NTCod⦈ =
      HomO.C⇘α⇙ψ⦇NTDGCod⦈(φ⦇NTDom⦈-,ψ⦇NTCod⦈-)"
    and "HomA.C⇘α⇙(φ-,ψ-)⦇NTDGDom⦈ = op_cat (φ⦇NTDGDom⦈) ×C ψ⦇NTDGDom⦈"
    and "HomA.C⇘α⇙(φ-,ψ-)⦇NTDGCod⦈ = cat_Set α"
  unfolding ntcf_Hom_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Natural transformation map›

mk_VLambda ntcf_Hom_components(1)
  |vsv ntcf_Hom_NTMap_vsv|

context
  fixes α φ ψ 𝔉 𝔊 𝔉' 𝔊' 𝔄 𝔅 ℭ
  assumes φ: "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and ψ: "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
begin

interpretation φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule φ)
interpretation ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule ψ)

mk_VLambda ntcf_Hom_components(1)[of _ φ ψ, simplified]
  |vdomain ntcf_Hom_NTMap_vdomain[unfolded in_Hom_iff]|

lemmas [cat_cs_simps] = ntcf_Hom_NTMap_vdomain

lemma ntcf_Hom_NTMap_app[cat_cs_simps]:
  assumes "[a, b]∘ ∈∘ (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
  shows "HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇a, b⦈∙ = ntcf_Hom_component φ ψ a b"
  using assms
  unfolding ntcf_Hom_components
  by (simp add: nat_omega_simps cat_cs_simps)

end

lemma (in category) ntcf_Hom_NTMap_vrange: 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "ℛ∘ (HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈) ⊆∘ cat_Set α⦇Arr⦈"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))
  show ?thesis
  proof
    (
      rule vsv.vsv_vrange_vsubset, 
      unfold ntcf_Hom_NTMap_vdomain[OF assms] cat_cs_simps
    )
    fix ab assume "ab ∈∘ (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ op_cat 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
      by 
        (
          rule cat_prod_2_ObjE[
            OF φ.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
            ]
        )
    from assms a b category_cat_Set category_axioms show 
      "HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈ ∈∘ cat_Set α⦇Arr⦈"
      unfolding ab_def cat_op_simps
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (simp add: ntcf_Hom_NTMap_vsv)
qed


subsubsection‹
Composition of a ‹Hom›-natural transformation with 
two natural transformations is a natural transformation
›

lemma (in category) cat_ntcf_Hom_is_ntcf: 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(φ-,ψ-) :
    HomO.C⇘α⇙ℭ(𝔊-,𝔉'-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,𝔊'-) :
    op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
proof-

  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(2))

  show ?thesis
  proof(intro is_ntcfI')
    show "vfsequence (HomA.C⇘α⇙(φ-,ψ-))" unfolding ntcf_Hom_def by simp
    show "vcard (HomA.C⇘α⇙(φ-,ψ-)) = 5ℕ"
      unfolding ntcf_Hom_def by (simp add: nat_omega_simps)
    from assms category_axioms show 
      "HomO.C⇘α⇙ℭ(𝔊-,𝔉'-) : op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
      by (cs_concl cs_shallow cs_intro: cat_cs_intros)
    from assms category_axioms show 
      "HomO.C⇘α⇙ℭ(𝔉-,𝔊'-) : op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
      by (cs_concl cs_shallow cs_intro: cat_cs_intros)
    from assms show "𝒟∘ (HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈) = (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show "HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈ :
      HomO.C⇘α⇙ℭ(𝔊-,𝔉'-)⦇ObjMap⦈⦇ab⦈ ↦⇘cat_Set α⇙
      HomO.C⇘α⇙ℭ(𝔉-,𝔊'-)⦇ObjMap⦈⦇ab⦈"
      if "ab ∈∘ (op_cat 𝔄 ×C 𝔅)⦇Obj⦈" for ab 
    proof-
      from that obtain a b
        where ab_def: "ab = [a, b]∘" 
          and a: "a ∈∘ op_cat 𝔄⦇Obj⦈" 
          and b: "b ∈∘ 𝔅⦇Obj⦈"
        by 
          (
            rule cat_prod_2_ObjE[
              OF φ.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
              ]
          )
      from category_axioms assms a b show 
        "HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈ :
          HomO.C⇘α⇙ℭ(𝔊-,𝔉'-)⦇ObjMap⦈⦇ab⦈ ↦⇘cat_Set α⇙
          HomO.C⇘α⇙ℭ(𝔉-,𝔊'-)⦇ObjMap⦈⦇ab⦈"
        unfolding ab_def cat_op_simps
        by 
          (
            cs_concl cs_shallow 
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
    show 
      "HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇a'b'⦈ ∘A⇘cat_Set α⇙
       HomO.C⇘α⇙ℭ(𝔊-,𝔉'-)⦇ArrMap⦈⦇gf⦈ =
        HomO.C⇘α⇙ℭ(𝔉-,𝔊'-)⦇ArrMap⦈⦇gf⦈ ∘A⇘cat_Set α⇙
        HomA.C⇘α⇙(φ-,ψ-)⦇NTMap⦈⦇ab⦈"
      if "gf : ab ↦⇘op_cat 𝔄 ×C 𝔅⇙ a'b'" for ab a'b' gf
    proof-
      from that obtain g f a b a' b'
        where gf_def: "gf = [g, f]∘" 
          and ab_def: "ab = [a, b]∘" 
          and a'b'_def: "a'b' = [a', b']∘"
          and g: "g : a ↦⇘op_cat 𝔄⇙ a'"
          and f: "f : b ↦⇘𝔅⇙ b'" 
        by 
          (
            elim 
              cat_prod_2_is_arrE[
                OF φ.NTDom.HomDom.category_op ψ.NTDom.HomDom.category_axioms
                ]
          )
      from assms category_axioms that g f show ?thesis
        unfolding gf_def ab_def a'b'_def cat_op_simps
        by (*slow*)
          (
            cs_concl 
              cs_simp: cat_ntcf_Hom_component_nat cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
    qed
  qed (auto simp: ntcf_Hom_components cat_cs_simps)

qed

lemma (in category) cat_ntcf_Hom_is_ntcf': 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" 
    and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "β = α"
    and "𝔄' = HomO.C⇘α⇙ℭ(𝔊-,𝔉'-)"
    and "𝔅' = HomO.C⇘α⇙ℭ(𝔉-,𝔊'-)"
    and "ℭ' = op_cat 𝔄 ×C 𝔅"
    and "𝔇' = cat_Set α"
  shows "HomA.C⇘α⇙(φ-,ψ-) : 𝔄' ↦CF 𝔅' : ℭ' ↦↦C⇘β⇙ 𝔇'"
  using assms(1-2) unfolding assms(3-7) by (rule cat_ntcf_Hom_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_Hom_is_ntcf'


subsubsection‹
Composition of a ‹Hom›-natural transformation with 
two vertical compositions of natural transformations
›

lemma (in category) cat_ntcf_Hom_vcomp:
  assumes "φ' : 𝔊 ↦CF ℌ : 𝔄 ↦↦C⇘α⇙ ℭ" 
    and "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ψ' : 𝔊' ↦CF ℌ' : 𝔅 ↦↦C⇘α⇙ ℭ" 
    and "ψ : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows 
    "HomA.C⇘α⇙(φ' ∙NTCF φ-,ψ' ∙NTCF ψ-) =
      HomA.C⇘α⇙(φ-,ψ'-) ∙NTCF HomA.C⇘α⇙(φ'-,ψ-)"
proof(rule ntcf_eqI[of α])

  interpret φ': is_ntcf α 𝔄 ℭ 𝔊 ℌ φ' by (rule assms(1))
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(2))
  interpret ψ': is_ntcf α 𝔅 ℭ 𝔊' ℌ' ψ' by (rule assms(3))
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉' 𝔊' ψ by (rule assms(4))

  from category_axioms assms show H_vcomp:
    "HomA.C⇘α⇙(φ' ∙NTCF φ-,ψ' ∙NTCF ψ-) :
      HomO.C⇘α⇙ℭ(ℌ-,𝔉'-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,ℌ'-) :
      op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show vcomp_H:
    "HomA.C⇘α⇙(φ-,ψ'-) ∙NTCF HomA.C⇘α⇙(φ'-,ψ-) :
      HomO.C⇘α⇙ℭ(ℌ-,𝔉'-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,ℌ'-) :
      op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms H_vcomp have dom_H_vcomp:
    "𝒟∘ (HomA.C⇘α⇙(φ' ∙NTCF φ-,ψ' ∙NTCF ψ-)⦇NTMap⦈) = (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms H_vcomp have dom_vcomp_H:
    "𝒟∘ ((HomA.C⇘α⇙(φ-,ψ'-) ∙NTCF HomA.C⇘α⇙(φ'-,ψ-))⦇NTMap⦈) =
      (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show "HomA.C⇘α⇙(φ' ∙NTCF φ-,ψ' ∙NTCF ψ-)⦇NTMap⦈ =
    (HomA.C⇘α⇙(φ-,ψ'-) ∙NTCF HomA.C⇘α⇙(φ'-,ψ-))⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_H_vcomp dom_vcomp_H)
    fix ab assume prems: "ab ∈∘ (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
      by 
        ( 
          auto 
            elim: 
              cat_prod_2_ObjE[
                OF φ'.NTDom.HomDom.category_op ψ'.NTDom.HomDom.category_axioms
                ]
            simp: cat_op_simps
        )
    from 
      assms a b
      category_axioms 
      φ'.NTDom.HomDom.category_axioms
      ψ'.NTDom.HomDom.category_axioms 
    show
      "HomA.C⇘α⇙(φ' ∙NTCF φ-,ψ' ∙NTCF ψ-)⦇NTMap⦈⦇ab⦈ =
        (HomA.C⇘α⇙(φ-,ψ'-) ∙NTCF HomA.C⇘α⇙(φ'-,ψ-))⦇NTMap⦈⦇ab⦈"
      by
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps ab_def
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed (auto simp: ntcf_Hom_NTMap_vsv cat_cs_intros)

qed simp_all

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_vcomp

lemma (in category) cat_ntcf_Hom_ntcf_id:
  assumes "𝔉 : 𝔄 ↦↦C⇘α⇙ ℭ" and "𝔉': 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-) = ntcf_id HomO.C⇘α⇙ℭ(𝔉-,𝔉'-)"
proof(rule ntcf_eqI[of α])

  interpret 𝔉: is_functor α 𝔄 ℭ 𝔉 by (rule assms(1))
  interpret 𝔉': is_functor α 𝔅 ℭ 𝔉' by (rule assms(2))

  from category_axioms assms show H_id:
    "HomA.C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-) :
      HomO.C⇘α⇙ℭ(𝔉-,𝔉'-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,𝔉'-) :
      op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show id_H:
    "ntcf_id HomO.C⇘α⇙ℭ(𝔉-,𝔉'-) :
      HomO.C⇘α⇙ℭ(𝔉-,𝔉'-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,𝔉'-) :
      op_cat 𝔄 ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  from category_axioms assms H_id have dom_H_id:
    "𝒟∘ (HomA.C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈) = (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms H_id have dom_id_H:
    "𝒟∘ (ntcf_id HomO.C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈) = (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

  show 
    "HomA.C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈ =
      ntcf_id HomO.C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold dom_H_id dom_id_H)
    show "vsv (HomA.C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈)" 
      by (rule ntcf_Hom_NTMap_vsv)
    from id_H show "vsv (ntcf_id HomO.C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈)"
      by (intro is_functor.ntcf_id_NTMap_vsv) 
        (cs_concl cs_shallow cs_intro: cat_cs_intros)
    fix ab assume "ab ∈∘ (op_cat 𝔄 ×C 𝔅)⦇Obj⦈"
    then obtain a b
      where ab_def: "ab = [a, b]∘" 
        and a: "a ∈∘ 𝔄⦇Obj⦈" 
        and b: "b ∈∘ 𝔅⦇Obj⦈"
      by 
        ( 
          auto 
            elim: 
              cat_prod_2_ObjE[OF 𝔉.HomDom.category_op 𝔉'.HomDom.category_axioms]
            simp: cat_op_simps
        )
    from category_axioms assms a b H_id id_H show
      "HomA.C⇘α⇙(ntcf_id 𝔉-,ntcf_id 𝔉'-)⦇NTMap⦈⦇ab⦈ = 
        ntcf_id HomO.C⇘α⇙ℭ(𝔉-,𝔉'-)⦇NTMap⦈⦇ab⦈"
      unfolding ab_def
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed simp

qed simp_all

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_ntcf_id



subsection‹
Composition of a ‹Hom›-natural transformation with a natural transformation
›


subsubsection‹Definition and elementary properties›


text‹See subsection 1.15 in cite‹"bodo_categories_1970"›.›

definition ntcf_lcomp_Hom :: "V ⇒ V ⇒ V" (‹HomA.Cı'(/_-,-/')›)
  where "HomA.C⇘α⇙(φ-,-) = HomA.C⇘α⇙(φ-,ntcf_id (cf_id (φ⦇NTDGCod⦈))-)"

definition ntcf_rcomp_Hom :: "V ⇒ V ⇒ V" (‹HomA.Cı'(/-,_-/')›)
  where "HomA.C⇘α⇙(-,ψ-) = HomA.C⇘α⇙(ntcf_id (cf_id (ψ⦇NTDGCod⦈))-,ψ-)"


subsubsection‹Natural transformation map›

lemma ntcf_lcomp_Hom_NTMap_vsv: "vsv (HomA.C⇘α⇙(φ-,-)⦇NTMap⦈)"
  unfolding ntcf_lcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)

lemma ntcf_rcomp_Hom_NTMap_vsv: "vsv (HomA.C⇘α⇙(-,ψ-)⦇NTMap⦈)"
  unfolding ntcf_rcomp_Hom_def by (rule ntcf_Hom_NTMap_vsv)

lemma ntcf_lcomp_Hom_NTMap_vdomain[cat_cs_simps]:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" 
  shows "𝒟∘ (HomA.C⇘α⇙(φ-,-)⦇NTMap⦈) = (op_cat 𝔄 ×C ℭ)⦇Obj⦈"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_def φ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_rcomp_Hom_NTMap_vdomain[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ" 
  shows "𝒟∘ (HomA.C⇘α⇙(-,ψ-)⦇NTMap⦈) = (op_cat ℭ ×C 𝔅)⦇Obj⦈"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_rcomp_Hom_def ψ.ntcf_NTDGCod
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemma ntcf_lcomp_Hom_NTMap_app[cat_cs_simps]:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat 𝔄⦇Obj⦈"
    and "b ∈∘ ℭ⦇Obj⦈"
  shows "HomA.C⇘α⇙(φ-,-)⦇NTMap⦈⦇a, b⦈∙ = ntcf_lcomp_Hom_component φ a b"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms show ?thesis
    unfolding
      ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
      cat_op_simps
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed

lemma ntcf_rcomp_Hom_NTMap_app[cat_cs_simps]:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "a ∈∘ op_cat ℭ⦇Obj⦈"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomA.C⇘α⇙(-,ψ-)⦇NTMap⦈⦇a, b⦈∙ = ntcf_rcomp_Hom_component ψ a b"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms show ?thesis
    unfolding 
      ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
      cat_op_simps
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps 
          cs_intro: cat_cs_intros cat_prod_cs_intros
      )
qed

lemma (in category) ntcf_lcomp_Hom_NTMap_vrange:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
  shows "ℛ∘ (HomA.C⇘α⇙(φ-,-)⦇NTMap⦈) ⊆∘ cat_Set α⦇Arr⦈"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_lcomp_Hom_def ntcf_lcomp_Hom_component_def φ.ntcf_NTDGCod
    by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed

lemma (in category) ntcf_rcomp_Hom_NTMap_vrange:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "ℛ∘ (HomA.C⇘α⇙(-,ψ-)⦇NTMap⦈) ⊆∘ cat_Set α⦇Arr⦈"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms show ?thesis
    unfolding ntcf_rcomp_Hom_def ntcf_rcomp_Hom_component_def ψ.ntcf_NTDGCod
    by (intro ntcf_Hom_NTMap_vrange) (cs_concl cs_intro: cat_cs_intros)+
qed


subsubsection‹
Composition of a ‹Hom›-natural transformation with 
a natural transformation is a natural transformation
›

lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf: 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" 
  shows "HomA.C⇘α⇙(φ-,-) :
    HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,-) : op_cat 𝔄 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms category_axioms show ?thesis
    unfolding 
      ntcf_lcomp_Hom_def cf_bcomp_Hom_cf_lcomp_Hom[symmetric] φ.ntcf_NTDGCod
    by (intro category.cat_ntcf_Hom_is_ntcf)
      (cs_concl cs_intro: cat_cs_intros)+
qed

lemma (in category) cat_ntcf_lcomp_Hom_is_ntcf': 
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" 
    and "β = α"
    and "𝔄' = HomO.C⇘α⇙ℭ(𝔊-,-)"
    and "𝔅' = HomO.C⇘α⇙ℭ(𝔉-,-)"
    and "ℭ' = op_cat 𝔄 ×C ℭ"
    and "𝔇' = cat_Set α"
  shows "HomA.C⇘α⇙(φ-,-) : 𝔄' ↦CF 𝔅' : ℭ' ↦↦C⇘β⇙ 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_lcomp_Hom_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_lcomp_Hom_is_ntcf'

lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf:
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ" 
  shows "HomA.C⇘α⇙(-,ψ-) :
    HomO.C⇘α⇙ℭ(-,𝔉-) ↦CF HomO.C⇘α⇙ℭ(-,𝔊-) : op_cat ℭ ×C 𝔅 ↦↦C⇘α⇙ cat_Set α"
proof-
  interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule assms(1))
  from assms category_axioms show ?thesis
    unfolding 
      ntcf_rcomp_Hom_def cf_bcomp_Hom_cf_rcomp_Hom[symmetric] ψ.ntcf_NTDGCod
    by (intro category.cat_ntcf_Hom_is_ntcf)
      (cs_concl cs_intro: cat_cs_intros)+
qed

lemma (in category) cat_ntcf_rcomp_Hom_is_ntcf':
  assumes "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "β = α"
    and "𝔄' = HomO.C⇘α⇙ℭ(-,𝔉-)"
    and "𝔅' = HomO.C⇘α⇙ℭ(-,𝔊-)"
    and "ℭ' = op_cat ℭ ×C 𝔅"  
    and "𝔇' = cat_Set α"
  shows "HomA.C⇘α⇙(-,ψ-) : 𝔄' ↦CF 𝔅' : ℭ' ↦↦C⇘α⇙ 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_rcomp_Hom_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_rcomp_Hom_is_ntcf'


subsubsection‹
Component of a composition of a ‹Hom›-natural transformation 
with a natural transformation and the Yoneda component
›

lemma (in category) cat_ntcf_lcomp_Hom_component_is_Yoneda_component:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "b ∈∘ op_cat 𝔅⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows 
    "ntcf_lcomp_Hom_component φ b c =
      Yoneda_component HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈) (φ⦇NTMap⦈⦇b⦈) c"
  (is ‹?lcomp = ?Yc›)
proof-

  interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))

  from assms(2) have b: "b ∈∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by clarsimp
  from b have 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈" and 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈"
    by (auto intro: cat_cs_intros)
  from assms(1,3) b category_axioms have φb:
    "φ⦇NTMap⦈⦇b⦈ ∈∘ HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-)⦇ObjMap⦈⦇𝔊⦇ObjMap⦈⦇b⦈⦈"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
      )

  have lcomp:
    "?lcomp : Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇b⦈) c"
    by (rule cat_ntcf_lcomp_Hom_component_is_arr[OF assms])
  then have dom_lhs: "𝒟∘ (?lcomp⦇ArrVal⦈) = Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c"
    by (cs_concl cs_simp: cat_cs_simps)  

  have Yc: "?Yc :
    Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c ↦⇘cat_Set α⇙ HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-)⦇ObjMap⦈⦇c⦈"
    by 
      (
        rule cat_Yoneda_component_is_arr[
          OF cat_cf_Hom_snd_is_functor[OF 𝔉b] 𝔊b φb assms(3)
          ]
      )
  then have dom_rhs: "𝒟∘ (?Yc⦇ArrVal⦈) = Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c"
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
  
    from lcomp show "arr_Set α ?lcomp" by (auto dest: cat_Set_is_arrD(1))
    from Yc show "arr_Set α ?Yc" by (auto dest: cat_Set_is_arrD(1))
  
    show "?lcomp⦇ArrVal⦈ = ?Yc⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      from assms(1) b category_axioms show "vsv (?Yc⦇ArrVal⦈)"
        by (intro is_functor.Yoneda_component_ArrVal_vsv)
          (cs_concl cs_shallow cs_intro: cat_cs_intros)
      show "?lcomp⦇ArrVal⦈⦇f⦈ = ?Yc⦇ArrVal⦈⦇f⦈"
        if "f ∈∘ Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c" for f
      proof-
        from that have "f : 𝔊⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ c" by simp
        with category_axioms assms(1,3) b show ?thesis
          by 
            (
              cs_concl cs_shallow
                cs_simp: cat_cs_simps cat_op_simps 
                cs_intro: cat_cs_intros cat_op_intros
            )
      qed
    qed (simp_all add: ntcf_lcomp_Hom_component_ArrVal_vsv)
    
    from Yc category_axioms assms(1,3) b have
      "?Yc : Hom ℭ (𝔊⦇ObjMap⦈⦇b⦈) c ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇b⦈) c"
      by 
        (
          cs_prems cs_shallow 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
            ) 
    with lcomp show "?lcomp⦇ArrCod⦈ = ?Yc⦇ArrCod⦈"
      by (cs_concl cs_simp: cat_cs_simps)
  
  qed (use lcomp Yc in ‹cs_concl cs_simp: cat_cs_simps›)

qed


subsubsection‹
Composition of a ‹Hom›-natural transformation with 
a vertical composition of natural transformations
›

lemma (in category) cat_ntcf_lcomp_Hom_vcomp:
  assumes "φ' : 𝔊 ↦CF ℌ : 𝔄 ↦↦C⇘α⇙ ℭ" and "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(φ' ∙NTCF φ-,-) = HomA.C⇘α⇙(φ-,-) ∙NTCF HomA.C⇘α⇙(φ'-,-)"
proof-
  interpret φ': is_ntcf α 𝔄 ℭ 𝔊 ℌ φ' by (rule assms(1))
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(2))
  from category_axioms have ntcf_id_cf_id:
    "ntcf_id (cf_id ℭ) = ntcf_id (cf_id ℭ) ∙NTCF ntcf_id (cf_id ℭ)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show ?thesis
    unfolding 
      ntcf_lcomp_Hom_def
      ntsmcf_vcomp_components 
      dghm_id_components 
      φ'.ntcf_NTDGCod
      φ.ntcf_NTDGCod
    by (subst ntcf_id_cf_id) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_vcomp

lemma (in category) cat_ntcf_rcomp_Hom_vcomp:
  assumes "φ' : 𝔊 ↦CF ℌ : 𝔄 ↦↦C⇘α⇙ ℭ" and "φ : 𝔉 ↦CF 𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(-,φ' ∙NTCF φ-) = HomA.C⇘α⇙(-,φ'-) ∙NTCF HomA.C⇘α⇙(-,φ-)"
proof-
  interpret φ': is_ntcf α 𝔄 ℭ 𝔊 ℌ φ' by (rule assms(1))
  interpret φ: is_ntcf α 𝔄 ℭ 𝔉 𝔊 φ by (rule assms(2))
  from category_axioms have ntcf_id_cf_id:
    "ntcf_id (cf_id ℭ) = ntcf_id (cf_id ℭ) ∙NTCF ntcf_id (cf_id ℭ)"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from category_axioms assms show ?thesis
    unfolding 
      ntcf_rcomp_Hom_def
      ntsmcf_vcomp_components 
      dghm_id_components 
      φ'.ntcf_NTDGCod
      φ.ntcf_NTDGCod
    by (subst ntcf_id_cf_id) 
      (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_vcomp


subsubsection‹
Composition of a ‹Hom›-natural transformation with an identity natural 
transformation
›

lemma (in category) cat_ntcf_lcomp_Hom_ntcf_id:
  assumes "𝔉 : 𝔄 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(ntcf_id 𝔉-,-) = ntcf_id HomO.C⇘α⇙ℭ(𝔉-,-)"
proof-
  interpret 𝔉: is_functor α 𝔄 ℭ 𝔉 by (rule assms(1))
  from category_axioms assms show ?thesis
    unfolding ntcf_lcomp_Hom_def ntcf_id_components 𝔉.cf_HomCod
    by
      (
        cs_concl 
          cs_simp: ntcf_lcomp_Hom_def cat_cs_simps 
          cs_intro: cat_cs_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_id

lemma (in category) cat_ntcf_rcomp_Hom_ntcf_id:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(-,ntcf_id 𝔉-) = ntcf_id HomO.C⇘α⇙ℭ(-,𝔉-)"
proof-
  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  from category_axioms assms show ?thesis
    unfolding ntcf_rcomp_Hom_def ntcf_id_components 𝔉.cf_HomCod
    by (cs_concl cs_simp: ntcf_rcomp_Hom_def cat_cs_simps cs_intro: cat_cs_intros)
qed

lemmas [cat_cs_simps] = category.cat_ntcf_rcomp_Hom_ntcf_id



subsection‹Projections of a ‹Hom›-natural transformation›


text‹
The concept of a projection of a ‹Hom›-natural transformation appears 
in the corollary to the Yoneda Lemma in Chapter III-2 in 
cite‹"mac_lane_categories_2010"› (although the concept has not been given
any specific name in the aforementioned reference).
›


subsubsection‹Definition and elementary properties›

definition ntcf_Hom_snd :: "V ⇒ V ⇒ V ⇒ V" (‹HomA.Cı_'(/_,-/')›)
  where "HomA.C⇘α⇙ℭ(f,-) =
    Yoneda_arrow α (HomO.C⇘α⇙ℭ(ℭ⦇Dom⦈⦇f⦈,-)) (ℭ⦇Cod⦈⦇f⦈) f"

definition ntcf_Hom_fst :: "V ⇒ V ⇒ V ⇒ V" (‹HomA.Cı_'(/-,_/')›)
  where "HomA.C⇘α⇙ℭ(-,f) = HomA.C⇘α⇙op_cat ℭ(f,-)"


text‹Components.›

lemma (in category) cat_ntcf_Hom_snd_components:
  assumes "f : s ↦⇘ℭ⇙ r"
  shows "HomA.C⇘α⇙ℭ(f,-)⦇NTMap⦈ = 
    (λd∈∘ℭ⦇Obj⦈. Yoneda_component HomO.C⇘α⇙ℭ(s,-) r f d)"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTDom⦈ = HomO.C⇘α⇙ℭ(r,-)"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTCod⦈ = HomO.C⇘α⇙ℭ(s,-)"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTDGDom⦈ = ℭ"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTDGCod⦈ = cat_Set α"
proof-
  interpret is_functor α ℭ ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(s,-)›
    using assms category_axioms by (cs_concl cs_intro: cat_cs_intros)
  show "HomA.C⇘α⇙ℭ(f,-)⦇NTMap⦈ =
    (λd∈∘ℭ⦇Obj⦈. Yoneda_component HomO.C⇘α⇙ℭ(s,-) r f d)"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTDom⦈ = HomO.C⇘α⇙ℭ(r,-)"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTCod⦈ = HomO.C⇘α⇙ℭ(s,-)"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTDGDom⦈ = ℭ"
    and "HomA.C⇘α⇙ℭ(f,-)⦇NTDGCod⦈ = cat_Set α"
    unfolding ntcf_Hom_snd_def cat_is_arrD[OF assms] Yoneda_arrow_components
    by simp_all
qed

lemma (in category) cat_ntcf_Hom_fst_components:
  assumes "f : r ↦⇘ℭ⇙ s"
  shows "HomA.C⇘α⇙ℭ(-,f)⦇NTMap⦈ =
    (λd∈∘op_cat ℭ⦇Obj⦈. Yoneda_component HomO.C⇘α⇙ℭ(-,s) r f d)"
    and "HomA.C⇘α⇙ℭ(-,f)⦇NTDom⦈ = HomO.C⇘α⇙ℭ(-,r)"
    and "HomA.C⇘α⇙ℭ(-,f)⦇NTCod⦈ = HomO.C⇘α⇙ℭ(-,s)"
    and "HomA.C⇘α⇙ℭ(-,f)⦇NTDGDom⦈ = op_cat ℭ"
    and "HomA.C⇘α⇙ℭ(-,f)⦇NTDGCod⦈ = cat_Set α"
  using category_axioms assms
  unfolding 
    ntcf_Hom_fst_def
    category.cat_ntcf_Hom_snd_components[
      OF category_op, unfolded cat_op_simps, OF assms
      ]
    cat_op_simps
  by (cs_concl cs_simp: cat_op_simps cs_intro: cat_cs_intros)+


text‹Alternative definition.›

lemma (in category) ntcf_Hom_snd_def':
  assumes "f : r ↦⇘ℭ⇙ s"
  shows "HomA.C⇘α⇙ℭ(f,-) = Yoneda_arrow α (HomO.C⇘α⇙ℭ(r,-)) s f"
  using assms unfolding ntcf_Hom_snd_def by (simp add: cat_cs_simps) 

lemma (in category) ntcf_Hom_fst_def':
  assumes "f : r ↦⇘ℭ⇙ s"
  shows "HomA.C⇘α⇙ℭ(-,f) = Yoneda_arrow α HomO.C⇘α⇙ℭ(-,s) r f"
proof-
  from assms category_axioms show ?thesis
    unfolding ntcf_Hom_fst_def ntcf_Hom_snd_def cat_op_simps
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
      )
qed


subsubsection‹Natural transformation map›

context category
begin

context
  fixes s r f
  assumes f: "f : s ↦⇘ℭ⇙ r"
begin

mk_VLambda cat_ntcf_Hom_snd_components(1)[OF f]
  |vsv ntcf_Hom_snd_NTMap_vsv[intro]|
  |vdomain ntcf_Hom_snd_NTMap_vdomain|
  |app ntcf_Hom_snd_NTMap_app|

end

context
  fixes s r f
  assumes f: "f : r ↦⇘ℭ⇙ s"
begin

mk_VLambda cat_ntcf_Hom_fst_components(1)[OF f]
  |vsv ntcf_Hom_fst_NTMap_vsv[intro]|
  |vdomain ntcf_Hom_fst_NTMap_vdomain|
  |app ntcf_Hom_fst_NTMap_app|

end

end

lemmas [cat_cs_simps] = 
  category.ntcf_Hom_snd_NTMap_vdomain
  category.ntcf_Hom_fst_NTMap_vdomain

lemmas ntcf_Hom_snd_NTMap_app[cat_cs_simps] = 
  category.ntcf_Hom_snd_NTMap_app
  category.ntcf_Hom_fst_NTMap_app


subsubsection‹
‹Hom›-natural transformation projections are natural transformations
›

lemma (in category) cat_ntcf_Hom_snd_is_ntcf:
  assumes "f : s ↦⇘ℭ⇙ r"
  shows "HomA.C⇘α⇙ℭ(f,-) :
    HomO.C⇘α⇙ℭ(r,-) ↦CF HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  note f = cat_is_arrD[OF assms]
  show ?thesis
    unfolding ntcf_Hom_snd_def f
  proof(rule category.cat_Yoneda_arrow_is_ntcf)
    from assms category_axioms show "f ∈∘ HomO.C⇘α⇙ℭ(s,-)⦇ObjMap⦈⦇r⦈"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  qed (intro category_axioms cat_cf_Hom_snd_is_functor f)+
qed

lemma (in category) cat_ntcf_Hom_snd_is_ntcf':
  assumes "f : s ↦⇘ℭ⇙ r"
    and "β = α"
    and "𝔄' = HomO.C⇘α⇙ℭ(r,-)"
    and "𝔅' = HomO.C⇘α⇙ℭ(s,-)"
    and "ℭ' = ℭ"
    and "𝔇' = cat_Set α"
  shows "HomA.C⇘α⇙ℭ(f,-) : 𝔄' ↦CF 𝔅' : ℭ' ↦↦C⇘β⇙ 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_snd_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_Hom_snd_is_ntcf'

lemma (in category) cat_ntcf_Hom_fst_is_ntcf:
  assumes "f : r ↦⇘ℭ⇙ s"
  shows "HomA.C⇘α⇙ℭ(-,f) :
    HomO.C⇘α⇙ℭ(-,r) ↦CF HomO.C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  from assms have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  from 
    category.cat_ntcf_Hom_snd_is_ntcf[
      OF category_op, 
      unfolded cat_op_simps, 
      OF assms, 
      unfolded cat_op_cat_cf_Hom_snd[OF r] cat_op_cat_cf_Hom_snd[OF s],
      folded ntcf_Hom_fst_def
      ]
  show ?thesis .
qed

lemma (in category) cat_ntcf_Hom_fst_is_ntcf':
  assumes "f : r ↦⇘ℭ⇙ s"
    and "β = α"
    and "𝔄' = HomO.C⇘α⇙ℭ(-,r)"
    and "𝔅' = HomO.C⇘α⇙ℭ(-,s)"
    and "ℭ' = op_cat ℭ"
    and "𝔇' = cat_Set α"
  shows "HomA.C⇘α⇙ℭ(-,f) : 𝔄' ↦CF 𝔅' : ℭ' ↦↦C⇘β⇙ 𝔇'"
  using assms(1) unfolding assms(2-6) by (rule cat_ntcf_Hom_fst_is_ntcf)

lemmas [cat_cs_intros] = category.cat_ntcf_Hom_fst_is_ntcf'


subsubsection‹Opposite ‹Hom›-natural transformation projections›

lemma (in category) cat_op_cat_ntcf_Hom_snd: 
  "HomA.C⇘α⇙op_cat ℭ(f,-) = HomA.C⇘α⇙ℭ(-,f)"
  unfolding ntcf_Hom_fst_def by simp

lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_snd

lemma (in category) cat_op_cat_ntcf_Hom_fst:
  "HomA.C⇘α⇙op_cat ℭ(-,f) = HomA.C⇘α⇙ℭ(f,-)"
  unfolding ntcf_Hom_fst_def cat_op_simps by simp

lemmas [cat_op_simps] = category.cat_op_cat_ntcf_Hom_fst


subsubsection‹
‹Hom›-natural transformation projections and the Yoneda component
›

lemma (in category) cat_Yoneda_component_cf_Hom_snd_Comp:
  assumes "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b" and "d ∈∘ ℭ⦇Obj⦈"
  shows 
    "Yoneda_component HomO.C⇘α⇙ℭ(a,-) b f d ∘A⇘cat_Set α⇙
      Yoneda_component HomO.C⇘α⇙ℭ(b,-) c g d =
      Yoneda_component HomO.C⇘α⇙ℭ(a,-) c (g ∘A⇘ℭ⇙ f) d"
    (is ‹?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d = ?Ya c (g ∘A⇘ℭ⇙ f) d›)
proof-

  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)

  note gD = cat_is_arrD[OF assms(1)]
  note fD = cat_is_arrD[OF assms(2)]

  from assms category_axioms have Y_f:
    "?Ya b f d : Hom ℭ b d ↦⇘cat_Set α⇙ Hom ℭ a d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  moreover from assms category_axioms have Y_g: 
    "?Yb c g d : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ b d"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
      )
  ultimately have Yf_Yg: 
    "?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ a d"
    by (auto intro: cat_cs_intros)
  from assms category_axioms have Y_gf: 
    "?Ya c (g ∘A⇘ℭ⇙ f) d : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ a d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  from Yf_Yg have dom_rhs: 
    "𝒟∘ ((?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d)⦇ArrVal⦈) = Hom ℭ c d"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  from Y_gf have dom_lhs: "𝒟∘ (?Ya c (g ∘A⇘ℭ⇙ f) d⦇ArrVal⦈) = Hom ℭ c d"  
    by (cs_concl cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from Yf_Yg show arr_Set_Yf_Yg: 
      "arr_Set α (?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret Yf_Yg: arr_Set α ‹?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d›
      by (rule arr_Set_Yf_Yg)
    from Y_gf show arr_Set_Y_gf: "arr_Set α (?Ya c (g ∘A⇘ℭ⇙ f) d)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret Yf_Yg: arr_Set α ‹?Ya c (g ∘A⇘ℭ⇙ f) d› by (rule arr_Set_Y_gf)
    show
      "(?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d)⦇ArrVal⦈ =
        ?Ya c (g ∘A⇘ℭ⇙ f) d⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume "h : c ↦⇘ℭ⇙ d"
      with Y_gf Y_g Y_f category_axioms assms show 
        "(?Ya b f d ∘A⇘cat_Set α⇙ ?Yb c g d)⦇ArrVal⦈⦇h⦈ =
          ?Ya c (g ∘A⇘ℭ⇙ f) d⦇ArrVal⦈⦇h⦈"
        (*slow*)
        by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    qed auto
  
  qed (use Y_gf Yf_Yg in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+

qed

lemmas [cat_cs_simps] = 
  category.cat_Yoneda_component_cf_Hom_snd_Comp[symmetric]

lemma (in category) cat_Yoneda_component_cf_Hom_snd_CId:
  assumes "c ∈∘ ℭ⦇Obj⦈" and "d ∈∘ ℭ⦇Obj⦈"
  shows 
    "Yoneda_component HomO.C⇘α⇙ℭ(c,-) c (ℭ⦇CId⦈⦇c⦈) d = 
      cat_Set α⦇CId⦈⦇Hom ℭ c d⦈"
  (is ‹?Ycd = cat_Set α⦇CId⦈⦇Hom ℭ c d⦈›)
proof-

  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)

  from assms category_axioms have Y_CId_c: 
    "?Ycd : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ c d"
    by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
  from Y_CId_c Set.category_axioms assms category_axioms have CId_cd:
    "cat_Set α⦇CId⦈⦇Hom ℭ c d⦈ : Hom ℭ c d ↦⇘cat_Set α⇙ Hom ℭ c d"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from Y_CId_c have dom_lhs: "𝒟∘ (?Ycd⦇ArrVal⦈) = Hom ℭ c d"  
    by (cs_concl cs_simp: cat_cs_simps)
  from CId_cd have dom_rhs: "𝒟∘ (cat_Set α⦇CId⦈⦇Hom ℭ c d⦈⦇ArrVal⦈) = Hom ℭ c d"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps)

  show ?thesis
  proof(rule arr_Set_eqI[of α])
    from Y_CId_c show arr_Set_Y_CId_c: "arr_Set α ?Ycd"
      by (auto dest: cat_Set_is_arrD(1))
    interpret Yf_Yg: arr_Set α ?Ycd by (rule arr_Set_Y_CId_c)
    from CId_cd show arr_Set_CId_cd: "arr_Set α (cat_Set α⦇CId⦈⦇Hom ℭ c d⦈)"
      by (auto dest: cat_Set_is_arrD(1))
    interpret CId_cd: arr_Set α ‹cat_Set α⦇CId⦈⦇Hom ℭ c d⦈›
      by (rule arr_Set_CId_cd)
    show "?Ycd⦇ArrVal⦈ = cat_Set α⦇CId⦈⦇Hom ℭ c d⦈⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)
      fix h assume "h : c ↦⇘ℭ⇙ d"
      with CId_cd Y_CId_c category_axioms assms show 
        "?Ycd⦇ArrVal⦈⦇h⦈ = cat_Set α⦇CId⦈⦇Hom ℭ c d⦈⦇ArrVal⦈⦇h⦈"
        by (cs_concl cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros)
    qed auto
  qed (use Y_CId_c CId_cd in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+

qed

lemmas [cat_cs_simps] = category.cat_Yoneda_component_cf_Hom_snd_CId


subsubsection‹‹Hom›-natural transformation projection of a composition›

lemma (in category) cat_ntcf_Hom_snd_Comp:
  assumes "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b"
  shows "HomA.C⇘α⇙ℭ(g ∘A⇘ℭ⇙ f,-) = HomA.C⇘α⇙ℭ(f,-) ∙NTCF HomA.C⇘α⇙ℭ(g,-)"
  (is ‹?H_gf = ?H_f ∙NTCF ?H_g›)
proof(rule ntcf_eqI[of α])
  from assms category_axioms show 
    "?H_gf : HomO.C⇘α⇙ℭ(c,-) ↦CF HomO.C⇘α⇙ℭ(a,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms show "?H_f ∙NTCF ?H_g :
    HomO.C⇘α⇙ℭ(c,-) ↦CF HomO.C⇘α⇙ℭ(a,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have lhs_dom: "𝒟∘ (?H_gf⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have rhs_dom:
    "𝒟∘ ((?H_f ∙NTCF ?H_g)⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "?H_gf⦇NTMap⦈ = (?H_f ∙NTCF ?H_g)⦇NTMap⦈"
  proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
    fix d assume "d ∈∘ ℭ⦇Obj⦈" 
    with assms category_axioms show 
      "?H_gf⦇NTMap⦈⦇d⦈ = (?H_f ∙NTCF ?H_g)⦇NTMap⦈⦇d⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  qed (use assms in ‹auto intro: cat_cs_intros›)
qed auto

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_Comp

lemma (in category) cat_ntcf_Hom_fst_Comp:
  assumes "g : b ↦⇘ℭ⇙ c" and "f : a ↦⇘ℭ⇙ b"
  shows "HomA.C⇘α⇙ℭ(-,g ∘A⇘ℭ⇙ f) = HomA.C⇘α⇙ℭ(-,g) ∙NTCF HomA.C⇘α⇙ℭ(-,f)"
proof-
  note category.cat_ntcf_Hom_snd_Comp[
      OF category_op, unfolded cat_op_simps, OF assms(2,1)
      ]
  from this category_axioms assms show ?thesis
    by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_Comp


subsubsection‹‹Hom›-natural transformation projection of an identity›

lemma (in category) cat_ntcf_Hom_snd_CId:
  assumes "c ∈∘ ℭ⦇Obj⦈"
  shows "HomA.C⇘α⇙ℭ(ℭ⦇CId⦈⦇c⦈,-) = ntcf_id HomO.C⇘α⇙ℭ(c,-)"
  (is ‹?H_c = ?id_H_c›)
proof(rule ntcf_eqI[of α])
  from assms have "ℭ⦇CId⦈⦇c⦈ : c ↦⇘ℭ⇙ c" by (auto simp: cat_cs_intros)
  from assms category_axioms show 
    "?H_c : HomO.C⇘α⇙ℭ(c,-) ↦CF HomO.C⇘α⇙ℭ(c,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms show 
    "?id_H_c : HomO.C⇘α⇙ℭ(c,-) ↦CF HomO.C⇘α⇙ℭ(c,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have lhs_dom: "𝒟∘ (?H_c⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms category_axioms have rhs_dom: "𝒟∘ (?id_H_c⦇NTMap⦈) = ℭ⦇Obj⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "?H_c⦇NTMap⦈ = ?id_H_c⦇NTMap⦈"
  proof(rule vsv_eqI, unfold lhs_dom rhs_dom)
    from assms category_axioms show "vsv (?id_H_c⦇NTMap⦈)"
      by (intro is_functor.ntcf_id_NTMap_vsv) 
        (cs_concl cs_shallow cs_simp: cs_intro: cat_cs_intros)
    fix d assume "d ∈∘ ℭ⦇Obj⦈" 
    with assms category_axioms show "?H_c⦇NTMap⦈⦇d⦈ = ?id_H_c⦇NTMap⦈⦇d⦈"
      by 
        (
          cs_concl cs_shallow 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
        )
  qed (use assms in ‹auto intro: cat_cs_intros›)
qed auto

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_snd_CId

lemma (in category) cat_ntcf_Hom_fst_CId:
  assumes "c ∈∘ ℭ⦇Obj⦈"
  shows "HomA.C⇘α⇙ℭ(-,ℭ⦇CId⦈⦇c⦈) = ntcf_id HomO.C⇘α⇙ℭ(-,c)"
proof-
  note category.cat_ntcf_Hom_snd_CId[
      OF category_op, unfolded cat_op_simps, OF assms
      ]
  from this category_axioms assms show ?thesis
    by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed

lemmas [cat_cs_simps] = category.cat_ntcf_Hom_fst_CId


subsubsection‹‹Hom›-natural transformation and the Yoneda map›

lemma (in category) cat_Yoneda_map_of_ntcf_Hom_snd:
  assumes "f : s ↦⇘ℭ⇙ r"
  shows "Yoneda_map α (HomO.C⇘α⇙ℭ(s,-)) r⦇HomA.C⇘α⇙ℭ(f,-)⦈ = f"
  using category_axioms assms (*slow*)
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_op_simps cat_Set_components(1)
        cs_intro: cat_cs_intros cat_prod_cs_intros
    ) 

lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_snd

lemma (in category) cat_Yoneda_map_of_ntcf_Hom_fst:
  assumes "f : r ↦⇘ℭ⇙ s"
  shows "Yoneda_map α (HomO.C⇘α⇙ℭ(-,s)) r⦇HomA.C⇘α⇙ℭ(-,f)⦈ = f"
proof-
  note category.cat_Yoneda_map_of_ntcf_Hom_snd[
      OF category_op, unfolded cat_op_simps, OF assms
      ]
  from this category_axioms assms show ?thesis
    by (cs_prems cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros) simp
qed

lemmas [cat_cs_simps] = category.cat_Yoneda_map_of_ntcf_Hom_fst



subsection‹Evaluation arrow›


subsubsection‹Definition and elementary properties›


text‹
The evaluation arrow is a part of the definition of the evaluation functor.
The evaluation functor appears in Chapter III-2 in
cite‹"mac_lane_categories_2010"›.
›

definition cf_eval_arrow :: "V ⇒ V ⇒ V ⇒ V"
  where "cf_eval_arrow ℭ 𝔑 f =
    [
      (
        λx∈∘𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈.
          𝔑⦇NTCod⦈⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈⦇ArrVal⦈⦇x⦈⦈
      ),
      𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈,
      𝔑⦇NTCod⦈⦇ObjMap⦈⦇ℭ⦇Cod⦈⦇f⦈⦈
    ]∘"


text‹Components.›

lemma cf_eval_arrow_components:
  shows "cf_eval_arrow ℭ 𝔑 f⦇ArrVal⦈ =
    (
      λx∈∘𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈.
        𝔑⦇NTCod⦈⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈⦇ArrVal⦈⦇x⦈⦈
    )"
    and "cf_eval_arrow ℭ 𝔑 f⦇ArrDom⦈ = 𝔑⦇NTDom⦈⦇ObjMap⦈⦇ℭ⦇Dom⦈⦇f⦈⦈"
    and "cf_eval_arrow ℭ 𝔑 f⦇ArrCod⦈ = 𝔑⦇NTCod⦈⦇ObjMap⦈⦇ℭ⦇Cod⦈⦇f⦈⦈"
  unfolding cf_eval_arrow_def arr_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔑 ℭ 𝔉 𝔊 a b f  
  assumes 𝔑: "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and f: "f : a ↦⇘ℭ⇙ b"
begin

interpretation 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule 𝔑)

lemmas cf_eval_arrow_components' = cf_eval_arrow_components[
    where ℭ=ℭ and 𝔑=‹ntcf_arrow 𝔑› and f=f, 
    unfolded 
      ntcf_arrow_components 
      cf_map_components 
      𝔑.NTDom.HomDom.cat_is_arrD[OF f]
      cat_cs_simps
    ]

lemmas [cat_cs_simps] = cf_eval_arrow_components'(2,3)

end


subsubsection‹Arrow value›

context
  fixes α 𝔑 ℭ 𝔉 𝔊 a b f  
  assumes 𝔑: "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and f: "f : a ↦⇘ℭ⇙ b"
begin

mk_VLambda cf_eval_arrow_components'(1)[OF 𝔑 f]
  |vsv cf_eval_arrow_ArrVal_vsv[cat_cs_intros]|
  |vdomain cf_eval_arrow_ArrVal_vdomain[cat_cs_simps]|
  |app cf_eval_arrow_ArrVal_app[cat_cs_simps]|

end


subsubsection‹Evaluation arrow is an arrow in the category ‹Set››

lemma cf_eval_arrow_is_arr:
  assumes "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α" and "f : a ↦⇘ℭ⇙ b"
  shows "cf_eval_arrow ℭ (ntcf_arrow 𝔑) f :
    𝔉⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ 𝔊⦇ObjMap⦈⦇b⦈"
proof-
  interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms)
  show ?thesis
  proof
    (
      intro cat_Set_is_arrI arr_SetI, 
      unfold cf_eval_arrow_components'(2,3)[OF assms]
    )
    show "vfsequence (cf_eval_arrow ℭ (ntcf_arrow 𝔑) f)"
      unfolding cf_eval_arrow_def by simp
    show "vcard (cf_eval_arrow ℭ (ntcf_arrow 𝔑) f) = 3ℕ"
      unfolding cf_eval_arrow_def by (simp add: nat_omega_simps)
    show "ℛ∘ (cf_eval_arrow ℭ (ntcf_arrow 𝔑) f⦇ArrVal⦈) ⊆∘ 𝔊⦇ObjMap⦈⦇b⦈"
      by 
      (
        unfold cf_eval_arrow_components'[OF assms], 
        intro vrange_VLambda_vsubset
      ) 
      (
        use assms in 
          ‹cs_concl cs_intro: cat_cs_intros cat_Set_cs_intros›
      )+
  qed
    (
      use assms(2) in
        ‹cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
    )+
qed

lemma cf_eval_arrow_is_arr'[cat_cs_intros]:
  assumes "𝔑' = ntcf_arrow 𝔑"
    and "𝔉a = 𝔉⦇ObjMap⦈⦇a⦈"
    and "𝔊b = 𝔊⦇ObjMap⦈⦇b⦈"
    and "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α" 
    and "f : a ↦⇘ℭ⇙ b"
  shows "cf_eval_arrow ℭ 𝔑' f : 𝔉a ↦⇘cat_Set α⇙ 𝔊b"
  using assms(4,5) unfolding assms(1-3) by (rule cf_eval_arrow_is_arr)

lemma (in category) cat_cf_eval_arrow_ntcf_vcomp[cat_cs_simps]:
  assumes "𝔐 : 𝔊 ↦CF ℌ : ℭ ↦↦C⇘α⇙ cat_Set α" 
    and "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "g : b ↦⇘ℭ⇙ c"
    and "f : a ↦⇘ℭ⇙ b"
  shows 
    "cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙NTCF 𝔑)) (g ∘A⇘ℭ⇙ f) =
      cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘A⇘cat_Set α⇙
      cf_eval_arrow ℭ (ntcf_arrow 𝔑) f"
proof-

  interpret 𝔐: is_ntcf α ℭ ‹cat_Set α› 𝔊 ℌ 𝔐 by (rule assms(1))
  interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms(2))

  have 𝔐𝔑: "𝔐 ∙NTCF 𝔑 : 𝔉 ↦CF ℌ : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(3,4) have gf: "g ∘A⇘ℭ⇙ f : a ↦⇘ℭ⇙ c"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 𝔐𝔑 gf have cf_eval_gf:
    "cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙NTCF 𝔑)) (g ∘A⇘ℭ⇙ f) :
      𝔉⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ ℌ⦇ObjMap⦈⦇c⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(3,4) have cf_eval_g_cf_eval_f:
    "cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘A⇘cat_Set α⇙
      cf_eval_arrow ℭ (ntcf_arrow 𝔑) f :
      𝔉⦇ObjMap⦈⦇a⦈ ↦⇘cat_Set α⇙ ℌ⦇ObjMap⦈⦇c⦈"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  note cf_eval_gf = cf_eval_gf cat_Set_is_arrD[OF cf_eval_gf]
  note cf_eval_g_cf_eval_f = 
    cf_eval_g_cf_eval_f cat_Set_is_arrD[OF cf_eval_g_cf_eval_f]

  interpret arr_Set_cf_eval_gf:
    arr_Set α ‹cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙NTCF 𝔑)) (g ∘A⇘ℭ⇙ f)›
    by (rule cf_eval_gf(2))
  interpret arr_Set_cf_eval_g_cf_eval_f:
    arr_Set 
      α 
      ‹
        cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘A⇘cat_Set α⇙
        cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
      ›
    by (rule cf_eval_g_cf_eval_f(2))

  show ?thesis
  proof(rule arr_Set_eqI)
    from 𝔐𝔑 gf have dom_lhs:
      "𝒟∘ (cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙NTCF 𝔑)) (g ∘A⇘ℭ⇙ f)⦇ArrVal⦈) = 
        𝔉⦇ObjMap⦈⦇a⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    from cf_eval_g_cf_eval_f(1) have dom_rhs: 
      "𝒟∘
        (
          (
            cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘A⇘cat_Set α⇙
            cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
          )⦇ArrVal⦈
        ) = 𝔉⦇ObjMap⦈⦇a⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    show
      "cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙NTCF 𝔑)) (g ∘A⇘ℭ⇙ f)⦇ArrVal⦈ =
        (
          cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘A⇘cat_Set α⇙
          cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
        )⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix 𝔉a assume prems: "𝔉a ∈∘ 𝔉⦇ObjMap⦈⦇a⦈"
      from 
        ArrVal_eq_helper
          [
            OF 𝔐.ntcf_Comp_commute[OF assms(4), symmetric], 
            where a=‹𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔉a⦈›
          ] 
        prems 
        assms(3,4) 
      have [cat_cs_simps]:
        "ℌ⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔐⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔉a⦈⦈⦈ =
          𝔐⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇𝔊⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇𝔉a⦈⦈⦈"
        by
          (
            cs_prems 
              cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
          )
      from prems assms(3,4) show 
        "cf_eval_arrow ℭ (ntcf_arrow (𝔐 ∙NTCF 𝔑)) (g ∘A⇘ℭ⇙ f)⦇ArrVal⦈⦇𝔉a⦈ =
          (
            cf_eval_arrow ℭ (ntcf_arrow 𝔐) g ∘A⇘cat_Set α⇙
            cf_eval_arrow ℭ (ntcf_arrow 𝔑) f
          )⦇ArrVal⦈⦇𝔉a⦈"
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_Set_cs_intros cat_cs_intros
          )
    qed (cs_concl cs_shallow cs_intro: V_cs_intros)
  qed
    (
      auto
        simp: cf_eval_gf cf_eval_g_cf_eval_f 
        intro: cf_eval_gf(2) cf_eval_g_cf_eval_f(2)
    )

qed

lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_vcomp

lemma (in category) cat_cf_eval_arrow_ntcf_id[cat_cs_simps]:
  assumes "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α" and "c ∈∘ ℭ⦇Obj⦈"
  shows 
    "cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈) =
      cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈"
proof-

  interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms)

  from assms(2) have ntcf_id_CId_c: 
    "cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈) :
      𝔉⦇ObjMap⦈⦇c⦈ ↦⇘cat_Set α⇙ 𝔉⦇ObjMap⦈⦇c⦈"
    by (cs_concl cs_intro: cat_cs_intros)
  from assms(2) have CId_𝔉c:
    "cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈ : 𝔉⦇ObjMap⦈⦇c⦈ ↦⇘cat_Set α⇙ 𝔉⦇ObjMap⦈⦇c⦈"
    by (cs_concl cs_intro: cat_cs_intros)

  show ?thesis
  proof(rule arr_Set_eqI[of α])

    from ntcf_id_CId_c show arr_Set_ntcf_id_CId_c:
      "arr_Set α (cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈))"
      by (auto dest: cat_Set_is_arrD(1))
    from ntcf_id_CId_c have dom_lhs:
      "𝒟∘ (cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)⦇ArrVal⦈) =
        𝔉⦇ObjMap⦈⦇c⦈"
      by (cs_concl cs_simp: cat_cs_simps)+
    interpret ntcf_id_CId_c: 
      arr_Set α ‹cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)›
      by (rule arr_Set_ntcf_id_CId_c)
  
    from CId_𝔉c show arr_Set_CId_𝔉c: "arr_Set α (cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈)"
      by (auto dest: cat_Set_is_arrD(1))
    from CId_𝔉c assms(2) have dom_rhs: 
      "𝒟∘ ((cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈)⦇ArrVal⦈) = 𝔉⦇ObjMap⦈⦇c⦈" 
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)

    show 
      "cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)⦇ArrVal⦈ =
        cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ 𝔉⦇ObjMap⦈⦇c⦈"
      with category_axioms assms(2) show 
        "cf_eval_arrow ℭ (ntcf_arrow (ntcf_id 𝔉)) (ℭ⦇CId⦈⦇c⦈)⦇ArrVal⦈⦇a⦈ =
          cat_Set α⦇CId⦈⦇𝔉⦇ObjMap⦈⦇c⦈⦈⦇ArrVal⦈⦇a⦈"
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (use arr_Set_ntcf_id_CId_c arr_Set_CId_𝔉c in auto)

  qed (use ntcf_id_CId_c CId_𝔉c in ‹cs_concl cs_simp: cat_cs_simps›)+

qed

lemmas [cat_cs_simps] = category.cat_cf_eval_arrow_ntcf_id



subsection‹‹HOM›-functor›


subsubsection‹Definition and elementary properties›


text‹
The following definition is a technical generalization that is used
later in this section.
›

definition cf_HOM_snd :: "V ⇒ V ⇒ V" (‹HOMCı'(/,_-/')›)
  where "HOMC⇘α⇙(,𝔉-) =
    [
      (λa∈∘op_cat (𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.C⇘α⇙(𝔉⦇HomCod⦈)(a,-) ∘CF 𝔉)),
      (
        λf∈∘op_cat (𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.C⇘α⇙(𝔉⦇HomCod⦈)(f,-) ∘NTCF-CF 𝔉)
      ),
      op_cat (𝔉⦇HomCod⦈),
      cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)
    ]∘"

definition cf_HOM_fst :: "V ⇒ V ⇒ V" (‹HOMCı'(/_-,/')›)
  where "HOMC⇘α⇙(𝔉-,) =
    [
      (λa∈∘(𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.C⇘α⇙(𝔉⦇HomCod⦈)(-,a) ∘CF op_cf 𝔉)),
      (
        λf∈∘(𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.C⇘α⇙(𝔉⦇HomCod⦈)(-,f) ∘NTCF-CF op_cf 𝔉)
      ),
      𝔉⦇HomCod⦈,
      cat_FUNCT α (op_cat (𝔉⦇HomDom⦈)) (cat_Set α)
    ]∘"


text‹Components.›

lemma cf_HOM_snd_components:
  shows "HOMC⇘α⇙(,𝔉-)⦇ObjMap⦈ =
      (λa∈∘op_cat (𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.C⇘α⇙(𝔉⦇HomCod⦈)(a,-) ∘CF 𝔉))"
    and "HOMC⇘α⇙(,𝔉-)⦇ArrMap⦈ =
      (
        λf∈∘op_cat (𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.C⇘α⇙(𝔉⦇HomCod⦈)(f,-) ∘NTCF-CF 𝔉)
      )"
    and [cat_cs_simps]: "HOMC⇘α⇙(,𝔉-)⦇HomDom⦈ = op_cat (𝔉⦇HomCod⦈)"
    and [cat_cs_simps]: 
      "HOMC⇘α⇙(,𝔉-)⦇HomCod⦈ = cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)"
  unfolding cf_HOM_snd_def dghm_field_simps by (simp_all add: nat_omega_simps)

lemma cf_HOM_fst_components:
  shows "HOMC⇘α⇙(𝔉-,)⦇ObjMap⦈ = 
      (λa∈∘(𝔉⦇HomCod⦈)⦇Obj⦈. cf_map (HomO.C⇘α⇙(𝔉⦇HomCod⦈)(-,a) ∘CF op_cf 𝔉))"
    and "HOMC⇘α⇙(𝔉-,)⦇ArrMap⦈ = 
      (
        λf∈∘(𝔉⦇HomCod⦈)⦇Arr⦈.
          ntcf_arrow (HomA.C⇘α⇙(𝔉⦇HomCod⦈)(-,f) ∘NTCF-CF op_cf 𝔉)
      )"
    and "HOMC⇘α⇙(𝔉-,)⦇HomDom⦈ = 𝔉⦇HomCod⦈"
    and "HOMC⇘α⇙(𝔉-,)⦇HomCod⦈ = cat_FUNCT α (op_cat (𝔉⦇HomDom⦈)) (cat_Set α)"
  unfolding cf_HOM_fst_def dghm_field_simps by (simp_all add: nat_omega_simps)

context is_functor
begin

lemmas cf_HOM_snd_components' = 
  cf_HOM_snd_components[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]

lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)

lemmas cf_HOM_fst_components' = 
  cf_HOM_fst_components[where 𝔉=𝔉, unfolded cf_HomDom cf_HomCod]

lemmas [cat_cs_simps] = cf_HOM_snd_components'(3,4)

end


subsubsection‹Object map›

mk_VLambda cf_HOM_snd_components(1)
  |vsv cf_HOM_snd_ObjMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_snd_components'(1)[unfolded cat_op_simps]
  |vdomain cf_HOM_snd_ObjMap_vdomain[cat_cs_simps]|
  |app cf_HOM_snd_ObjMap_app[cat_cs_simps]|

mk_VLambda cf_HOM_snd_components(1)
  |vsv cf_HOM_fst_ObjMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_fst_components'(1)[unfolded cat_op_simps]
  |vdomain cf_HOM_fst_ObjMap_vdomain[cat_cs_simps]|
  |app cf_HOM_fst_ObjMap_app[cat_cs_simps]|


subsubsection‹Arrow map›

mk_VLambda cf_HOM_snd_components(2)
  |vsv cf_HOM_snd_ArrMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_snd_components'(2)[unfolded cat_op_simps]
  |vdomain cf_HOM_snd_ArrMap_vdomain[cat_cs_simps]|
  |app cf_HOM_snd_ArrMap_app[cat_cs_simps]|

mk_VLambda cf_HOM_fst_components(2)
  |vsv cf_HOM_fst_ArrMap_vsv[cat_cs_intros]|

mk_VLambda (in is_functor) cf_HOM_fst_components'(2)[unfolded cat_op_simps]
  |vdomain cf_HOM_fst_ArrMap_vdomain[cat_cs_simps]|
  |app cf_HOM_fst_ArrMap_app[cat_cs_simps]|


subsubsection‹Opposite ‹HOM›-functor›

lemma (in is_functor) cf_HOM_snd_op[cat_op_simps]: 
  "HOMC⇘α⇙(,op_cf 𝔉-) = HOMC⇘α⇙(𝔉-,)"
proof-
  have dom_lhs: "𝒟∘ HOMC⇘α⇙(,op_cf 𝔉-) = 4ℕ"
    unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
  have dom_rhs: "𝒟∘ HOMC⇘α⇙(𝔉-,) = 4ℕ"
    unfolding cf_HOM_fst_def by (simp add: nat_omega_simps)
  show ?thesis
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume "a ∈∘ 4ℕ"
    then show "HOMC⇘α⇙(,op_cf 𝔉-)⦇a⦈ = HOMC⇘α⇙(𝔉-,)⦇a⦈"
    proof
      (
        elim_in_numeral, 
        use nothing in ‹fold dghm_field_simps, unfold cat_cs_simps›
      )
      show "HOMC⇘α⇙(,op_cf 𝔉-)⦇ObjMap⦈ = HOMC⇘α⇙(𝔉-,)⦇ObjMap⦈"
        unfolding 
          cf_HOM_fst_components' 
          is_functor.cf_HOM_snd_components'[OF is_functor_op]
        by (rule VLambda_eqI, unfold cat_op_simps)
         (
           cs_concl cs_shallow 
            cs_simp: cat_cs_simps cat_op_simps cs_intro: cat_cs_intros
         )+
      show "HOMC⇘α⇙(,op_cf 𝔉-)⦇ArrMap⦈ = HOMC⇘α⇙(𝔉-,)⦇ArrMap⦈"
        unfolding 
          cf_HOM_fst_components' 
          is_functor.cf_HOM_snd_components'[OF is_functor_op]
        by (rule VLambda_eqI, unfold cat_op_simps)
          (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)+ 
    qed 
      (
        auto simp:
          cf_HOM_fst_components' cat_cs_simps cat_op_simps cat_op_intros
      )
  qed (auto simp: cf_HOM_snd_def cf_HOM_fst_def)
qed

lemmas [cat_op_simps] = is_functor.cf_HOM_snd_op

context is_functor
begin

lemmas cf_HOM_fst_op[cat_op_simps] = 
  is_functor.cf_HOM_snd_op[OF is_functor_op, unfolded cat_op_simps, symmetric]

end

lemmas [cat_op_simps] = is_functor.cf_HOM_fst_op


subsubsection‹‹HOM›-functor is a functor›

lemma (in is_functor) cf_HOM_snd_is_functor: 
  assumes "𝒵 β" and "α ∈∘ β"
  shows "HOMC⇘α⇙(,𝔉-) : op_cat 𝔅 ↦↦C⇘β⇙ cat_FUNCT α 𝔄 (cat_Set α)"
proof-

  interpret β: 𝒵 β by (rule assms(1))
  interpret βℭ: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+

  show ?thesis
  proof(intro is_functorI', unfold cat_op_simps)
    show "vfsequence HOMC⇘α⇙(,𝔉-)" unfolding cf_HOM_snd_def by auto
    show "vcard HOMC⇘α⇙(,𝔉-) = 4ℕ"
      unfolding cf_HOM_snd_def by (simp add: nat_omega_simps)
    show "ℛ∘ (HOMC⇘α⇙(,𝔉-)⦇ObjMap⦈) ⊆∘ cat_FUNCT α 𝔄 (cat_Set α)⦇Obj⦈"
      unfolding cf_HOM_snd_components'
    proof(rule vrange_VLambda_vsubset, unfold cat_op_simps)
      fix b assume prems: "b ∈∘ 𝔅⦇Obj⦈"
      with assms(2) show 
        "cf_map (HomO.C⇘α⇙𝔅(b,-) ∘CF 𝔉) ∈∘ cat_FUNCT α 𝔄 (cat_Set α)⦇Obj⦈"
        by
          (
            cs_concl 
              cs_simp: cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show 
      "HOMC⇘α⇙(,𝔉-)⦇ArrMap⦈⦇f ∘A⇘𝔅⇙ g⦈ = 
        HOMC⇘α⇙(,𝔉-)⦇ArrMap⦈⦇g⦈ ∘A⇘cat_FUNCT α 𝔄 (cat_Set α)⇙
        HOMC⇘α⇙(,𝔉-)⦇ArrMap⦈⦇f⦈"
      if "g : c ↦⇘𝔅⇙ b" and "f : b ↦⇘𝔅⇙ a" for b c g a f
      using that 
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show 
      "HOMC⇘α⇙(,𝔉-)⦇ArrMap⦈⦇𝔅⦇CId⦈⦇c⦈⦈ =
        cat_FUNCT α 𝔄 (cat_Set α)⦇CId⦈⦇HOMC⇘α⇙(,𝔉-)⦇ObjMap⦈⦇c⦈⦈"
      if "c ∈∘ 𝔅⦇Obj⦈" for c 
      using that
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed 
    (
      use assms(2) in
        ‹
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
            cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
        ›
    )+

qed

lemma (in is_functor) cf_HOM_snd_is_functor'[cat_cs_intros]: 
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "ℭ' = op_cat 𝔅"
    and "𝔇 = cat_FUNCT α 𝔄 (cat_Set α)"
  shows "HOMC⇘α⇙(,𝔉-) : ℭ' ↦↦C⇘β⇙ 𝔇"
  using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_snd_is_functor)

lemmas [cat_cs_intros] = is_functor.cf_HOM_snd_is_functor'

lemma (in is_functor) cf_HOM_fst_is_functor: 
  assumes "𝒵 β" and "α ∈∘ β"
  shows "HOMC⇘α⇙(𝔉-,) : 𝔅 ↦↦C⇘β⇙ cat_FUNCT α (op_cat 𝔄) (cat_Set α)"
  by 
    (
      rule is_functor.cf_HOM_snd_is_functor[
        OF is_functor_op assms, unfolded cat_op_simps
        ]
   )

lemma (in is_functor) cf_HOM_fst_is_functor'[cat_cs_intros]: 
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "ℭ' = 𝔅"
    and "𝔇 = cat_FUNCT α (op_cat 𝔄) (cat_Set α)"
  shows "HOMC⇘α⇙(𝔉-,) : ℭ' ↦↦C⇘β⇙ 𝔇"
  using assms(1,2) unfolding assms(3,4) by (rule cf_HOM_fst_is_functor)

lemmas [cat_cs_intros] = is_functor.cf_HOM_fst_is_functor'



subsection‹Evaluation functor›


subsubsection‹Definition and elementary properties›


text‹See Chapter III-2 in cite‹"mac_lane_categories_2010"›.›

definition cf_eval :: "V ⇒ V ⇒ V ⇒ V"
  where "cf_eval α β ℭ =
    [
      (λ𝔉d∈∘(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈. 𝔉d⦇0⦈⦇ObjMap⦈⦇𝔉d⦇1ℕ⦈⦈),
      (
        λ𝔑f∈∘(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Arr⦈.
          cf_eval_arrow ℭ (𝔑f⦇0⦈) (𝔑f⦇1ℕ⦈)
      ),
      cat_FUNCT α ℭ (cat_Set α) ×C ℭ,
      cat_Set β
    ]∘"


text‹Components.›

lemma cf_eval_components:
  shows "cf_eval α β ℭ⦇ObjMap⦈ =
    (λ𝔉d∈∘(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈. 𝔉d⦇0⦈⦇ObjMap⦈⦇𝔉d⦇1ℕ⦈⦈)"
    and "cf_eval α β ℭ⦇ArrMap⦈ =
      (
        λ𝔑f∈∘(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Arr⦈.
          cf_eval_arrow ℭ (𝔑f⦇0⦈) (𝔑f⦇1ℕ⦈)
      )"
    and [cat_cs_simps]: 
      "cf_eval α β ℭ⦇HomDom⦈ = cat_FUNCT α ℭ (cat_Set α) ×C ℭ"
    and [cat_cs_simps]: "cf_eval α β ℭ⦇HomCod⦈ = cat_Set β"
  unfolding cf_eval_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Object map›

lemma cf_eval_ObjMap_vsv[cat_cs_intros]: "vsv (cf_eval α β ℭ⦇ObjMap⦈)"
  unfolding cf_eval_components by simp

lemma cf_eval_ObjMap_vdomain[cat_cs_simps]: 
  "𝒟∘ (cf_eval α β ℭ⦇ObjMap⦈) = (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈"
  unfolding cf_eval_components by simp

lemma (in category) cf_eval_ObjMap_app[cat_cs_simps]: 
  assumes "𝔉c = [cf_map 𝔉, c]∘"
    and "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α" (*the order of premises is important*)
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈ = 𝔉⦇ObjMap⦈⦇c⦈"
proof-
  interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms(2))
  define β where "β = α + ω"
  have "𝒵 β" and αβ: "α ∈∘ β" 
    by (simp_all add: β_def 𝒵_Limit_αω 𝒵_ω_αω 𝒵_def 𝒵_α_αω)
  then interpret β: 𝒵 β by simp 
  note [cat_small_cs_intros] = cat_category_if_ge_Limit
  from assms(2,3) αβ have "𝔉c ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈"
    by 
      (
        cs_concl cs_shallow
          cs_simp: assms(1) cat_FUNCT_components(1)
          cs_intro: 
            cat_cs_intros 
            cat_small_cs_intros 
            cat_prod_cs_intros 
            cat_FUNCT_cs_intros
      )
  then show ?thesis
    by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed

lemmas [cat_cs_simps] = category.cf_eval_ObjMap_app


subsubsection‹Arrow map›

lemma cf_eval_ArrMap_vsv[cat_cs_intros]: "vsv (cf_eval α β ℭ⦇ArrMap⦈)"
  unfolding cf_eval_components by simp

lemma cf_eval_ArrMap_vdomain[cat_cs_simps]: 
  "𝒟∘ (cf_eval α β ℭ⦇ArrMap⦈) = (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Arr⦈"
  unfolding cf_eval_components by simp

lemma (in category) cf_eval_ArrMap_app[cat_cs_simps]: 
  assumes "𝔑f = [ntcf_arrow 𝔑, f]∘"
    and "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "f : a ↦⇘ℭ⇙ b"
  shows "cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ = cf_eval_arrow ℭ (ntcf_arrow 𝔑) f"
proof-
  interpret 𝔉: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms(2))
  define β where "β = α + ω"
  have "𝒵 β" and αβ: "α ∈∘ β" 
    by (simp_all add: β_def 𝒵_Limit_αω 𝒵_ω_αω 𝒵_def 𝒵_α_αω)
  then interpret β: 𝒵 β by simp 
  note [cat_small_cs_intros] = cat_category_if_ge_Limit
  from assms(1,3) αβ have "𝔑f ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Arr⦈"
    by 
      (
        cs_concl 
          cs_simp: assms(1) cat_FUNCT_components(1)
          cs_intro: 
            cat_cs_intros 
            cat_small_cs_intros 
            cat_prod_cs_intros 
            cat_FUNCT_cs_intros
      )
  then show ?thesis
    by (simp add: assms(1) cf_map_components cf_eval_components nat_omega_simps)
qed

lemmas [cat_cs_simps] = category.cf_eval_ArrMap_app


subsubsection‹Evaluation functor is a functor›

lemma (in category) cat_cf_eval_is_functor:
  assumes "𝒵 β" and "α ∈∘ β"
  shows "cf_eval α β ℭ : cat_FUNCT α ℭ (cat_Set α) ×C ℭ ↦↦C⇘β⇙ cat_Set β"
proof-

  interpret β: 𝒵 β by (rule assms(1))
  from assms(2) cat_category_if_ge_Limit[OF assms] interpret FUNCT: 
    category β ‹(cat_FUNCT α ℭ (cat_Set α))›
    by 
      (
        cs_concl cs_intro: 
          cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )
  interpret βℭ: category β ℭ
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
    by (rule subcategory_cat_Set_cat_Set[OF assms])
  
  show ?thesis
  proof(intro is_functorI')
    show "vfsequence (cf_eval α β ℭ)" unfolding cf_eval_def by simp
    from cat_category_if_ge_Limit[OF assms] show 
      "category β ((cat_FUNCT α ℭ (cat_Set α)) ×C ℭ)"
      by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_cs_intros)
    show "vcard (cf_eval α β ℭ) = 4ℕ" 
      unfolding cf_eval_def by (simp add: nat_omega_simps)
    show "ℛ∘ (cf_eval α β ℭ⦇ObjMap⦈) ⊆∘ cat_Set β⦇Obj⦈"
    proof(intro vsv.vsv_vrange_vsubset, unfold cat_cs_simps)
      fix 𝔉c assume prems: "𝔉c ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈"
      then obtain 𝔉 c 
        where 𝔉c_def: "𝔉c = [𝔉, c]∘"
          and 𝔉: "𝔉 ∈∘ cf_maps α ℭ (cat_Set α)"
          and c: "c ∈∘ ℭ⦇Obj⦈"
        by 
          (
            auto 
              elim: cat_prod_2_ObjE[rotated 2] 
              intro: FUNCT.category_axioms βℭ.category_axioms
              simp: cat_FUNCT_components(1)
          )
      from 𝔉 obtain 𝔊 where 𝔉_def: "𝔉 = cf_map 𝔊"
        and 𝔊: "𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
        by (elim cf_mapsE)        
      interpret 𝔊: is_functor α ℭ ‹cat_Set α› 𝔊 by (rule 𝔊)
      from 𝔊 c show "cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈ ∈∘ cat_Set β⦇Obj⦈"
        unfolding 𝔉c_def 𝔉_def 
        by 
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_Set_αβ.subcat_Obj_vsubset
          )
    qed (cs_concl cs_shallow cs_intro: cat_cs_intros)
    show "cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ :
      cf_eval α β ℭ⦇ObjMap⦈⦇𝔉a⦈ ↦⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔊b⦈"
      if 𝔑f: "𝔑f : 𝔉a ↦⇘cat_FUNCT α ℭ (cat_Set α) ×C ℭ⇙ 𝔊b" for 𝔉a 𝔊b 𝔑f
    proof-
      obtain 𝔑 f 𝔉 a 𝔊 b
        where 𝔑f_def: "𝔑f = [𝔑, f]∘" 
          and 𝔉a_def: "𝔉a = [𝔉, a]∘"
          and 𝔊b_def: "𝔊b = [𝔊, b]∘" 
          and 𝔑: "𝔑 : 𝔉 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ 𝔊" 
          and f: "f : a ↦⇘ℭ⇙ b"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔑f] 
              FUNCT.category_axioms 
              βℭ.category_axioms
          )
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
      from 𝔑(1) f assms(2) show "cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ :
        cf_eval α β ℭ⦇ObjMap⦈⦇𝔉a⦈ ↦⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔊b⦈"
        unfolding 𝔑f_def 𝔉a_def 𝔊b_def
        by
          (
            intro cat_Set_αβ.subcat_is_arrD,
            use nothing in ‹subst 𝔑(2), subst 𝔑(3), subst 𝔑(4)›
          )
          (
            cs_concl 
              cs_simp: cat_FUNCT_cs_simps cat_cs_simps cs_intro: cat_cs_intros 
          ) (*slow*)
    qed
    show 
      "cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g ∘A⇘cat_FUNCT α ℭ (cat_Set α) ×C ℭ⇙ 𝔑f⦈ =
        cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g⦈ ∘A⇘cat_Set β⇙ cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈"
      if 𝔐g: "𝔐g : 𝔊b ↦⇘cat_FUNCT α ℭ (cat_Set α) ×C ℭ⇙ ℌc"
        and 𝔑f: "𝔑f : 𝔉a ↦⇘cat_FUNCT α ℭ (cat_Set α) ×C ℭ⇙ 𝔊b"
      for 𝔑f 𝔐g 𝔉a 𝔊b ℌc
    proof-
      obtain 𝔑 f 𝔉 a 𝔊 b
        where 𝔑f_def: "𝔑f = [𝔑, f]∘" 
          and 𝔉a_def: "𝔉a = [𝔉, a]∘"
          and 𝔊b_def: "𝔊b = [𝔊, b]∘" 
          and 𝔑: "𝔑 : 𝔉 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ 𝔊" 
          and f: "f : a ↦⇘ℭ⇙ b"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔑f] 
              FUNCT.category_axioms 
              βℭ.category_axioms
          )
      then obtain 𝔐 g ℌ c
        where 𝔐g_def: "𝔐g = [𝔐, g]∘" 
          and ℌc_def: "ℌc = [ℌ, c]∘" 
          and 𝔐: "𝔐 : 𝔊 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ℌ"
          and g: "g : b ↦⇘ℭ⇙ c"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔐g] 
              FUNCT.category_axioms
              βℭ.category_axioms
          )
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
        and 𝔐 = cat_FUNCT_is_arrD[OF 𝔐]
      from 𝔑(1) 𝔐(1) f g show
        "cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g ∘A⇘cat_FUNCT α ℭ (cat_Set α) ×C ℭ⇙ 𝔑f⦈ =
          cf_eval α β ℭ⦇ArrMap⦈⦇𝔐g⦈ ∘A⇘cat_Set β⇙ cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈"
        unfolding 𝔐g_def 𝔑f_def 𝔉a_def 𝔊b_def ℌc_def
        by 
          (
            subst (1 2) 𝔐(2), use nothing in ‹subst (1 2) 𝔑(2)›, 
            cs_concl_step cs_shallow cat_Set_αβ.subcat_Comp_simp[symmetric]
          )
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
          )
    qed
    show
      "cf_eval α β ℭ⦇ArrMap⦈⦇(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇CId⦈⦇𝔉c⦈⦈ =
        cat_Set β⦇CId⦈⦇cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈⦈"
      if "𝔉c ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈" for 𝔉c
    proof-
      from that obtain 𝔉 c where 𝔉c_def: "𝔉c = [𝔉, c]∘"
        and 𝔉: "𝔉 ∈∘ cf_maps α ℭ (cat_Set α)"
        and c: "c ∈∘ ℭ⦇Obj⦈"
        by 
          (
            auto 
              elim: cat_prod_2_ObjE[rotated 2] 
              intro: FUNCT.category_axioms βℭ.category_axioms
              simp: cat_FUNCT_components(1)
          )
      from 𝔉 obtain 𝔊 where 𝔉_def: "𝔉 = cf_map 𝔊"
        and 𝔊: "𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
        by (elim cf_mapsE)
      interpret 𝔊: is_functor α ℭ ‹cat_Set α› 𝔊 by (rule 𝔊)
      from 𝔊 c show 
        "cf_eval α β ℭ⦇ArrMap⦈⦇(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇CId⦈⦇𝔉c⦈⦈ =
          cat_Set β⦇CId⦈⦇cf_eval α β ℭ⦇ObjMap⦈⦇𝔉c⦈⦈"
        unfolding 𝔉c_def 𝔉_def
        by (cs_concl_step cat_Set_αβ.subcat_CId[symmetric])
          (
            cs_concl
              cs_simp: cat_cs_simps cat_prod_cs_simps cat_FUNCT_cs_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
          )
    qed

  qed (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)+

qed

lemma (in category) cat_cf_eval_is_functor':
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "𝔄' = cat_FUNCT α ℭ (cat_Set α) ×C ℭ"
    and "𝔅' = cat_Set β"
    and "β' = β"
  shows "cf_eval α β ℭ : 𝔄' ↦↦C⇘β'⇙ 𝔅'"
  using assms(1,2) unfolding assms(3-5) by (rule cat_cf_eval_is_functor) 

lemmas [cat_cs_intros] = category.cat_cf_eval_is_functor'



subsection‹‹N›-functor›


subsubsection‹Definition and elementary properties›


text‹See Chapter III-2 in cite‹"mac_lane_categories_2010"›.›

definition cf_nt :: "V ⇒ V ⇒ V ⇒ V"
  where "cf_nt α β 𝔉 =
    bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
      (HomO.C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))"


text‹Alternative definition.›

lemma (in is_functor) cf_nt_def':
  "cf_nt α β 𝔉 =
    bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
      (HomO.C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))"
  unfolding cf_nt_def cf_HomDom cf_HomCod by simp


text‹Components.›

lemma cf_nt_components:
  shows "cf_nt α β 𝔉⦇ObjMap⦈ =
    (
      bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
        (HomO.C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
    )⦇ObjMap⦈"
    and "cf_nt α β 𝔉⦇ArrMap⦈ =
      (
        bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇ArrMap⦈"
    and "cf_nt α β 𝔉⦇HomDom⦈ =
      (
        bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇HomDom⦈"
    and "cf_nt α β 𝔉⦇HomCod⦈ =
      (
        bifunctor_flip (𝔉⦇HomCod⦈) (cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α (𝔉⦇HomDom⦈) (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇HomCod⦈"
  unfolding cf_nt_def by simp_all

lemma (in is_functor) cf_nt_components':
  assumes "𝒵 β" and "α ∈∘ β"
  shows "cf_nt α β 𝔉⦇ObjMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇ObjMap⦈"
    and "cf_nt α β 𝔉⦇ArrMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇ArrMap⦈"
    and [cat_cs_simps]: 
      "cf_nt α β 𝔉⦇HomDom⦈ = cat_FUNCT α 𝔄 (cat_Set α) ×C 𝔅"
    and [cat_cs_simps]: 
      "cf_nt α β 𝔉⦇HomCod⦈ = cat_Set β"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  show 
    "cf_nt α β 𝔉⦇ObjMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇ObjMap⦈"
    "cf_nt α β 𝔉⦇ArrMap⦈ =
      (
        bifunctor_flip 𝔅 (cat_FUNCT α 𝔄 (cat_Set α))
          (HomO.C⇘β⇙cat_FUNCT α 𝔄 (cat_Set α)(HOMC⇘α⇙(,𝔉-)-,-))
      )⦇ArrMap⦈"
    "cf_nt α β 𝔉⦇HomDom⦈ = cat_FUNCT α 𝔄 (cat_Set α) ×C 𝔅"
    "cf_nt α β 𝔉⦇HomCod⦈ = cat_Set β"
    unfolding cf_nt_def 
    using assms(2)
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro: cat_small_cs_intros cat_cs_intros cat_FUNCT_cs_intros
      )+
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_components'(3,4)


subsubsection‹Object map›

lemma cf_nt_ObjMap_vsv[cat_cs_intros]: "vsv (cf_nt α β ℭ⦇ObjMap⦈)"
  unfolding cf_nt_components by (cs_intro_step cat_cs_intros)

lemma (in is_functor) cf_nt_ObjMap_vdomain[cat_cs_simps]: 
  assumes "𝒵 β" and "α ∈∘ β"
  shows "𝒟∘ (cf_nt α β 𝔉⦇ObjMap⦈) = (cat_FUNCT α 𝔄 (cat_Set α) ×C 𝔅)⦇Obj⦈"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  from assms(2) show ?thesis
    unfolding cf_nt_components
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro: 
            cat_small_cs_intros
            cat_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_vdomain

lemma (in is_functor) cf_nt_ObjMap_app[cat_cs_simps]: 
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "𝔊b = [cf_map 𝔊, b]∘"
    and "𝔊 : 𝔄 ↦↦C⇘α⇙ cat_Set α"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "cf_nt α β 𝔉⦇ObjMap⦈⦇𝔊b⦈ = Hom
    (cat_FUNCT α 𝔄 (cat_Set α))
    (cf_map (HomO.C⇘α⇙𝔅(b,-) ∘CF 𝔉))
    (cf_map 𝔊)"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret 𝔊: is_functor α 𝔄 ‹cat_Set α› 𝔊 by (rule assms(4))
  from assms(2,5) show ?thesis
    unfolding assms(3) cf_nt_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps 
          cs_intro:
            cat_cs_intros
            cat_small_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros 
            cat_op_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ObjMap_app


subsubsection‹Arrow map›

lemma cf_nt_ArrMap_vsv[cat_cs_intros]: "vsv (cf_nt α β ℭ⦇ArrMap⦈)"
  unfolding cf_nt_components by (cs_intro_step cat_cs_intros)

lemma (in is_functor) cf_nt_ArrMap_vdomain[cat_cs_simps]: 
  assumes "𝒵 β" and "α ∈∘ β"
  shows "𝒟∘ (cf_nt α β 𝔉⦇ArrMap⦈) = (cat_FUNCT α 𝔄 (cat_Set α) ×C 𝔅)⦇Arr⦈"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  from assms(2) show ?thesis
    unfolding cf_nt_components
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro: 
            cat_small_cs_intros
            cat_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_vdomain

lemma (in is_functor) cf_nt_ArrMap_app[cat_cs_simps]: 
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "𝔑f = [ntcf_arrow 𝔑, f]∘"
    and "𝔑 : 𝔊 ↦CF ℌ : 𝔄 ↦↦C⇘α⇙ cat_Set α"
    and "f : a ↦⇘𝔅⇙ b"
  shows "cf_nt α β 𝔉⦇ArrMap⦈⦇𝔑f⦈ = cf_hom
    (cat_FUNCT α 𝔄 (cat_Set α))
    [ntcf_arrow (HomA.C⇘α⇙𝔅(f,-) ∘NTCF-CF 𝔉), ntcf_arrow 𝔑]∘"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret 𝔑: is_ntcf α 𝔄 ‹cat_Set α› 𝔊 ℌ 𝔑 by (rule assms(4))
  from assms(2,5) show ?thesis
    unfolding assms(3) cf_nt_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_FUNCT_cs_simps cat_op_simps
          cs_intro:
            cat_cs_intros
            cat_small_cs_intros
            cat_FUNCT_cs_intros
            cat_prod_cs_intros
            cat_op_intros
      )
qed

lemmas [cat_cs_simps] = is_functor.cf_nt_ArrMap_app


subsubsection‹‹N›-functor is a functor›

lemma (in is_functor) cf_nt_is_functor:
  assumes "𝒵 β" and "α ∈∘ β"
  shows "cf_nt α β 𝔉 : cat_FUNCT α 𝔄 (cat_Set α) ×C 𝔅 ↦↦C⇘β⇙ cat_Set β"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  interpret β𝔄: category β 𝔄
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret β𝔅: category β 𝔅
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  from assms(2) show ?thesis
    unfolding cf_nt_def'
    by 
      (
        cs_concl 
          cs_simp: cat_op_simps 
          cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
qed

lemma (in is_functor) cf_nt_is_functor':
  assumes "𝒵 β" 
    and "α ∈∘ β"
    and "𝔄' = cat_FUNCT α 𝔄 (cat_Set α) ×C 𝔅"
    and "𝔅' = cat_Set β"
    and "β' = β"
  shows "cf_nt α β 𝔉 : 𝔄' ↦↦C⇘β'⇙ 𝔅'"
  using assms(1,2) unfolding assms(3-5) by (rule cf_nt_is_functor) 

lemmas [cat_cs_intros] = is_functor.cf_nt_is_functor'



subsection‹Yoneda natural transformation arrow›


subsubsection‹Definition and elementary properties›


text‹
The following subsection is based on the elements of the content
of Chapter III-2 in cite‹"mac_lane_categories_2010"›. 
›

definition ntcf_Yoneda_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_Yoneda_arrow α ℭ 𝔉 r =
    [
      (
        λψ∈∘Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (HomO.C⇘α⇙ℭ(r,-))) 𝔉.
          Yoneda_map α (cf_of_cf_map ℭ (cat_Set α) 𝔉) r⦇
            ntcf_of_ntcf_arrow ℭ (cat_Set α) ψ
            ⦈
      ),
      Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (HomO.C⇘α⇙ℭ(r,-))) 𝔉,
      𝔉⦇ObjMap⦈⦇r⦈
    ]∘"


text‹Components›

lemma ntcf_Yoneda_arrow_components:
  shows "ntcf_Yoneda_arrow α ℭ 𝔉 r⦇ArrVal⦈ = 
    (
      λψ∈∘Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (HomO.C⇘α⇙ℭ(r,-))) 𝔉.
        Yoneda_map α (cf_of_cf_map ℭ (cat_Set α) 𝔉) r⦇
          ntcf_of_ntcf_arrow ℭ (cat_Set α) ψ
          ⦈
    )"
    and [cat_cs_simps]: "ntcf_Yoneda_arrow α ℭ 𝔉 r⦇ArrDom⦈ = 
      Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map (HomO.C⇘α⇙ℭ(r,-))) 𝔉"
    and [cat_cs_simps]: "ntcf_Yoneda_arrow α ℭ 𝔉 r⦇ArrCod⦈ = 𝔉⦇ObjMap⦈⦇r⦈"
  unfolding ntcf_Yoneda_arrow_def arr_field_simps
  by (simp_all add: nat_omega_simps)


subsubsection‹Arrow map›

mk_VLambda ntcf_Yoneda_arrow_components(1)
  |vsv ntcf_Yoneda_arrow_vsv[cat_cs_intros]|
  |vdomain ntcf_Yoneda_arrow_vdomain[cat_cs_simps]|

context category
begin

context
  fixes 𝔉 :: V
begin

mk_VLambda ntcf_Yoneda_arrow_components(1)[where α=α and ℭ=ℭ and 𝔉=‹cf_map 𝔉›]
  |app ntcf_Yoneda_arrow_app'|

lemmas ntcf_Yoneda_arrow_app =
  ntcf_Yoneda_arrow_app'[unfolded in_Hom_iff, cat_cs_simps]

end

end

lemmas [cat_cs_simps] = category.ntcf_Yoneda_arrow_app


subsubsection‹Several technical lemmas›

lemma (in vsv) vsv_vrange_VLambda_app:
  assumes "g ` elts A = elts (𝒟∘ r)"
  shows "ℛ∘ (λx∈∘A. r⦇g x⦈) = ℛ∘ r"
proof(intro vsubset_antisym vsv.vsv_vrange_vsubset, unfold vdomain_VLambda)
  show "(λx∈∘A. r⦇g x⦈)⦇x⦈ ∈∘ ℛ∘ r" if "x ∈∘ A" for x
  proof-
    from assms that have "g x ∈∘ 𝒟∘ r" by auto
    then have "r⦇g x⦈ ∈∘ ℛ∘ r" by force
    with that show ?thesis by simp
  qed
  show "r⦇x⦈ ∈∘ ℛ∘ (λx∈∘A. r⦇g x⦈)" if "x ∈∘ 𝒟∘ r" for x
  proof-
    from that assms have "x ∈ g ` elts A" by simp
    then obtain c where c: "c ∈∘ A" and x_def: "x = g c" by clarsimp
    from c show ?thesis unfolding x_def by auto
  qed
qed auto

lemma (in vsv) vsv_vrange_VLambda_app':
  assumes "g ` elts A = elts (𝒟∘ r)"
    and "R = ℛ∘ r"
  shows "ℛ∘ (λx∈∘A. r⦇g x⦈) = R"
  using assms(1) unfolding assms(2) by (rule vsv_vrange_VLambda_app)

lemma (in v11) v11_VLambda_v11_bij_betw_comp:
  assumes "bij_betw g (elts A) (elts (𝒟∘ r))"
  shows "v11 (λx∈∘A. r⦇g x⦈)"
proof(rule vsv.vsv_valeq_v11I, unfold vdomain_VLambda beta)
  fix x y assume prems: "x ∈∘ A" "y ∈∘ A" "r⦇g x⦈ = r⦇g y⦈"
  from assms prems(1,2) have "g x ∈∘ 𝒟∘ r" and "g y ∈∘ 𝒟∘ r" by auto
  from v11_injective[OF this prems(3)] have "g x = g y".
  with assms prems(1,2) show "x = y" unfolding bij_betw_def inj_on_def by simp
qed simp


subsubsection‹
Yoneda natural transformation arrow is an arrow in the category ‹Set›
›

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r :
    Hom 
      (cat_FUNCT α ℭ (cat_Set α))
      (cf_map (HomO.C⇘α⇙ℭ(r,-)))
      (cf_map 𝔉) ↦iso⇘cat_Set β⇙
    𝔉⦇ObjMap⦈⦇r⦈"
proof-

  interpret β: 𝒵 β by (rule assms(1))
  interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms)

  from assms(2) interpret FUNCT: tiny_category β ‹cat_FUNCT α ℭ (cat_Set α)›
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)

  let ?Hom_r = ‹HomO.C⇘α⇙ℭ(r,-)›

  from assms have [cat_cs_simps]: "cf_of_cf_map ℭ (cat_Set α) (cf_map 𝔉) = 𝔉"
    by (cs_concl cs_shallow cs_simp: cat_FUNCT_cs_simps)

  note Yoneda = cat_Yoneda_Lemma[OF assms(3,4)]

  show ?thesis
  proof
    (
      intro cat_Set_is_iso_arrI cat_Set_is_arrI arr_SetI,
      unfold cat_cs_simps cf_map_components
    )
    show "vfsequence (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r)"
      unfolding ntcf_Yoneda_arrow_def by simp
    show "vcard (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r) = 3ℕ"
      unfolding ntcf_Yoneda_arrow_def by (simp add: nat_omega_simps)
    show "ℛ∘ (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r⦇ArrVal⦈) = 𝔉⦇ObjMap⦈⦇r⦈"
      unfolding cat_cs_simps cf_map_components ntcf_Yoneda_arrow_components 
      by (intro vsv.vsv_vrange_VLambda_app', unfold Yoneda(2))
        (
          use assms(4) in
            ‹
              cs_concl cs_shallow
                cs_simp:
                  cat_cs_simps bij_betwD(2)[OF bij_betw_ntcf_of_ntcf_arrow_Hom]
                cs_intro: cat_cs_intros
            ›
        )+
    then show "ℛ∘ (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r⦇ArrVal⦈) ⊆∘ 𝔉⦇ObjMap⦈⦇r⦈"
      by auto
    from assms(4) show "v11 (ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r⦇ArrVal⦈)"
      unfolding ntcf_Yoneda_arrow_components
      by 
        (
          intro v11.v11_VLambda_v11_bij_betw_comp, 
          unfold cat_cs_simps 𝔉.Yoneda_map_vdomain; 
          intro Yoneda bij_betw_ntcf_of_ntcf_arrow_Hom
        )
        (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms(4) show 
      "Hom (cat_FUNCT α ℭ (cat_Set α)) (cf_map ?Hom_r) (cf_map 𝔉) ∈∘ Vset β"
      by (intro FUNCT.cat_Hom_in_Vset)
        (
          cs_concl cs_shallow
            cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    from assms(4) have "𝔉⦇ObjMap⦈⦇r⦈ ∈∘ Vset α" 
      by (cs_concl cs_intro: cat_cs_intros)
    then show "𝔉⦇ObjMap⦈⦇r⦈ ∈∘ Vset β"
      by (auto simp: assms(2) Vset_trans Vset_in_mono)
  qed (auto intro: cat_cs_intros)

qed

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr_isomoprhism':
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔉' = cf_map 𝔉"
    and "B = 𝔉⦇ObjMap⦈⦇r⦈"
    and "A = Hom 
      (cat_FUNCT α ℭ (cat_Set α))
      (cf_map (HomO.C⇘α⇙ℭ(r,-)))
      (cf_map 𝔉)"
    and "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow α ℭ 𝔉' r : A ↦iso⇘cat_Set β⇙ B"
  using assms(1,2,6,7) 
  unfolding assms(3-5)
  by (rule cat_ntcf_Yoneda_arrow_is_arr_isomoprhism)

lemmas [cat_arrow_cs_intros] = 
  category.cat_ntcf_Yoneda_arrow_is_arr_isomoprhism'

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r :
    Hom
      (cat_FUNCT α ℭ (cat_Set α))
      (cf_map (HomO.C⇘α⇙ℭ(r,-)))
      (cf_map 𝔉) ↦⇘cat_Set β⇙
    𝔉⦇ObjMap⦈⦇r⦈"
  by 
    (
      rule cat_Set_is_iso_arrD[
        OF cat_ntcf_Yoneda_arrow_is_arr_isomoprhism[OF assms]
        ]
    )

lemma (in category) cat_ntcf_Yoneda_arrow_is_arr'[cat_cs_intros]:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔉' = cf_map 𝔉"
    and "B = 𝔉⦇ObjMap⦈⦇r⦈"
    and "A = Hom 
      (cat_FUNCT α ℭ (cat_Set α))
      (cf_map (HomO.C⇘α⇙ℭ(r,-)))
      (cf_map 𝔉)"
    and "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda_arrow α ℭ 𝔉' r : A ↦⇘cat_Set β⇙ B"
  using assms(1,2,6,7) 
  unfolding assms(3-5)
  by (rule cat_ntcf_Yoneda_arrow_is_arr)

lemmas [cat_arrow_cs_intros] = category.cat_ntcf_Yoneda_arrow_is_arr'


subsection‹Commutativity law for the Yoneda natural transformation arrow›

lemma (in category) cat_ntcf_Yoneda_arrow_commute:
  assumes "𝒵 β"
    and "α ∈∘ β"
    and "𝔑 : 𝔉 ↦CF 𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "f : a ↦⇘ℭ⇙ b" 
  shows 
    "ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙
      cf_hom
        (cat_FUNCT α ℭ (cat_Set α)) 
        [ntcf_arrow HomA.C⇘α⇙ℭ(f,-), ntcf_arrow 𝔑]∘ =
          cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘A⇘cat_Set β⇙
            ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a"
proof-

  let ?hom = 
    ‹
      cf_hom
        (cat_FUNCT α ℭ (cat_Set α)) 
        [ntcf_arrow HomA.C⇘α⇙ℭ(f,-), ntcf_arrow 𝔑]∘
    ›

  interpret β: 𝒵 β by (rule assms(1))
  interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› 𝔉 𝔊 𝔑 by (rule assms(3))
  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)
  interpret βℭ: category β ℭ
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  interpret cat_Set_αβ: subcategory β ‹cat_Set α› ‹cat_Set β›
    by (rule subcategory_cat_Set_cat_Set[OF assms(1,2)])

  from assms(2,4) have 𝔊b_𝔑f:
    "ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙ ?hom :
      Hom
        (cat_FUNCT α ℭ (cat_Set α))
        (cf_map (HomO.C⇘α⇙ℭ(a,-)))
        (cf_map 𝔉) ↦⇘cat_Set β⇙
      𝔊⦇ObjMap⦈⦇b⦈"
    by
      (
        cs_concl 
          cs_intro:
            cat_small_cs_intros
            cat_cs_intros
            cat_prod_cs_intros
            cat_op_intros
            cat_FUNCT_cs_intros
      )

  from assms(2,4) have 𝔑f_𝔉a:
    "cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘A⇘cat_Set β⇙
      ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a :
      Hom
        (cat_FUNCT α ℭ (cat_Set α))
        (cf_map (HomO.C⇘α⇙ℭ(a,-)))
        (cf_map 𝔉) ↦⇘cat_Set β⇙
      𝔊⦇ObjMap⦈⦇b⦈"
    by (cs_concl cs_intro: cat_cs_intros cat_Set_αβ.subcat_is_arrD)

  show ?thesis
  proof(rule arr_Set_eqI[of β])

    from 𝔊b_𝔑f show arr_Set_𝔊b_𝔑f:
      "arr_Set β (ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙ ?hom)"
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔊b_𝔑f have dom_lhs: 
      "𝒟∘ ((ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙ ?hom)⦇ArrVal⦈) = 
        Hom
          (cat_FUNCT α ℭ (cat_Set α))
          (cf_map (HomO.C⇘α⇙ℭ(a,-)))
          (cf_map 𝔉)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)+
    interpret 𝔑f_𝔉a: arr_Set 
      β ‹ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙ ?hom›
      by (rule arr_Set_𝔊b_𝔑f)
  
    from 𝔑f_𝔉a show arr_Set_𝔑f_𝔉a:
      "arr_Set 
        β 
        (
          cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘A⇘cat_Set β⇙
          ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
        )"
      by (auto dest: cat_Set_is_arrD(1))
    from 𝔑f_𝔉a have dom_rhs: 
      "𝒟∘ 
        (
          (
            cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘A⇘cat_Set β⇙
            ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
          )⦇ArrVal⦈
        ) = Hom
          (cat_FUNCT α ℭ (cat_Set α))
          (cf_map (HomO.C⇘α⇙ℭ(a,-)))
          (cf_map 𝔉)" 
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)

    show 
      "(ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙ ?hom)⦇ArrVal⦈ =
        (
          cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘A⇘cat_Set β⇙
          ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
        )⦇ArrVal⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs in_Hom_iff)

      fix 𝔐 assume prems: 
        "𝔐 : cf_map HomO.C⇘α⇙ℭ(a,-) ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ cf_map 𝔉"

      from assms(4) have [cat_cs_simps]:
        "cf_of_cf_map ℭ (cat_Set α) (cf_map HomO.C⇘α⇙ℭ(a,-)) = HomO.C⇘α⇙ℭ(a,-)"
        "cf_of_cf_map ℭ (cat_Set α) (cf_map 𝔉) = 𝔉"
        by (cs_concl cs_simp: cat_FUNCT_cs_simps cs_intro: cat_cs_intros)

      note 𝔐 = cat_FUNCT_is_arrD[OF prems, unfolded cat_cs_simps]

      interpret 𝔐: is_ntcf 
        α ℭ ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(a,-)› 𝔉 ‹ntcf_of_ntcf_arrow ℭ (cat_Set α) 𝔐›
        by (rule 𝔐(1))

      have 𝔊𝔑_eq_𝔑𝔉:
        "𝔊⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔑⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇A⦈⦈ =
          𝔑⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇𝔉⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇A⦈⦈"
        if "A ∈∘ 𝔉⦇ObjMap⦈⦇a⦈" for A      
        using 
          ArrVal_eq_helper[
            OF 𝔑.ntcf_Comp_commute[OF assms(4), symmetric], where a=A
            ]
          assms(4)
          that
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from 𝔐(1) assms(2,3,4) have 𝔐a_CId_a: 
        "𝔐⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇ℭ⦇CId⦈⦇a⦈⦈ ∈∘ 𝔉⦇ObjMap⦈⦇a⦈"
        by (subst 𝔐)
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
              cs_intro: cat_Set_cs_intros cat_cs_intros
          )

      have 𝔉f_𝔐a_eq_𝔐b:
        "𝔉⦇ArrMap⦈⦇f⦈⦇ArrVal⦈⦇𝔐⦇NTMap⦈⦇a⦈⦇ArrVal⦈⦇h⦈⦈ =
          𝔐⦇NTMap⦈⦇b⦈⦇ArrVal⦈⦇f ∘A⇘ℭ⇙ h⦈"
        if "h : a ↦⇘ℭ⇙ a" for h
        using 
          ArrVal_eq_helper[
            OF 𝔐.ntcf_Comp_commute[OF assms(4), symmetric], where a=h
            ]
          that
          assms(4)
          category_axioms
        by
          (
            cs_prems cs_shallow
              cs_simp: 
                cat_FUNCT_cs_simps 
                cat_map_extra_cs_simps 
                cat_cs_simps 
                cat_op_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros cat_op_intros
          )
    
      from 𝔐(1) assms(2,3,4) 𝔐a_CId_a category_axioms show 
        "(ntcf_Yoneda_arrow α ℭ (cf_map 𝔊) b ∘A⇘cat_Set β⇙ ?hom)⦇ArrVal⦈⦇𝔐⦈ =
          (
            cf_eval_arrow ℭ (ntcf_arrow 𝔑) f ∘A⇘cat_Set β⇙
            ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) a
          )⦇ArrVal⦈⦇𝔐⦈" 
        by (subst (1 2) 𝔐(2)) (*very slow*)
          (
            cs_concl 
              cs_simp:
                𝔉f_𝔐a_eq_𝔐b 𝔊𝔑_eq_𝔑𝔉
                cat_map_extra_cs_simps 
                cat_FUNCT_cs_simps 
                cat_cs_simps 
                cat_op_simps
                cat_Set_components(1)
              cs_intro: 
                cat_Set_αβ.subcat_is_arrD 
                cat_small_cs_intros
                cat_cs_intros 
                cat_FUNCT_cs_intros
                cat_prod_cs_intros
                cat_op_intros
          )

    qed (use arr_Set_𝔊b_𝔑f arr_Set_𝔑f_𝔉a in auto)

  qed (use 𝔊b_𝔑f 𝔑f_𝔉a in ‹cs_concl cs_shallow cs_simp: cat_cs_simps›)+

qed



subsection‹Yoneda Lemma: naturality›


subsubsection‹
The Yoneda natural transformation: definition and elementary properties
›


text‹
The main result of this subsection corresponds to the corollary to the 
Yoneda Lemma on page 61 in cite‹"mac_lane_categories_2010"›.
›

definition ntcf_Yoneda :: "V ⇒ V ⇒ V ⇒ V"
  where "ntcf_Yoneda α β ℭ =
    [
      (
        λ𝔉r∈∘(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈. 
          ntcf_Yoneda_arrow α ℭ (𝔉r⦇0⦈) (𝔉r⦇1ℕ⦈)
      ),
      cf_nt α β (cf_id ℭ),
      cf_eval α β ℭ,
      cat_FUNCT α ℭ (cat_Set α) ×C ℭ,
      cat_Set β
    ]∘"


text‹Components.›

lemma ntcf_Yoneda_components:
  shows "ntcf_Yoneda α β ℭ⦇NTMap⦈ =
    (
      λ𝔉r∈∘(cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈.
        ntcf_Yoneda_arrow α ℭ (𝔉r⦇0⦈) (𝔉r⦇1ℕ⦈)
    )"
    and [cat_cs_simps]: "ntcf_Yoneda α β ℭ⦇NTDom⦈ = cf_nt α β (cf_id ℭ)"
    and [cat_cs_simps]: "ntcf_Yoneda α β ℭ⦇NTCod⦈ = cf_eval α β ℭ"
    and [cat_cs_simps]: 
      "ntcf_Yoneda α β ℭ⦇NTDGDom⦈ = cat_FUNCT α ℭ (cat_Set α) ×C ℭ"
    and [cat_cs_simps]: "ntcf_Yoneda α β ℭ⦇NTDGCod⦈ = cat_Set β"
  unfolding ntcf_Yoneda_def nt_field_simps by (simp_all add: nat_omega_simps)
    

subsubsection‹Natural transformation map›

mk_VLambda ntcf_Yoneda_components(1)
  |vsv ntcf_Yoneda_NTMap_vsv[cat_cs_intros]|
  |vdomain ntcf_Yoneda_NTMap_vdomain[cat_cs_intros]|

lemma (in category) ntcf_Yoneda_NTMap_app[cat_cs_simps]:
  assumes "𝒵 β"
    and "α ∈∘ β" 
    and "𝔉r = [cf_map 𝔉, r]∘"
    and "𝔉 : ℭ ↦↦C⇘α⇙ cat_Set α"
    and "r ∈∘ ℭ⦇Obj⦈"
  shows "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉r⦈ = ntcf_Yoneda_arrow α ℭ (cf_map 𝔉) r"
proof-            
  interpret β: 𝒵 β by (rule assms(1))
  interpret 𝔉: is_functor α ℭ ‹cat_Set α› 𝔉 by (rule assms(4))
  interpret βℭ: category β ℭ
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  from assms(2) interpret FUNCT: category β ‹cat_FUNCT α ℭ (cat_Set α)›
    by
      (
        cs_concl cs_shallow 
          cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )
  from assms(5) have "[cf_map 𝔉, r]∘ ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈"
    by
      (
        cs_concl cs_shallow
          cs_simp: cat_FUNCT_cs_simps
          cs_intro: cat_cs_intros cat_prod_cs_intros cat_FUNCT_cs_intros
      )
  then show ?thesis
    unfolding assms(3) ntcf_Yoneda_components by (simp add: nat_omega_simps)
qed

lemmas [cat_cs_simps] = category.ntcf_Yoneda_NTMap_app


subsubsection‹The Yoneda natural transformation is a natural transformation›

lemma (in category) cat_ntcf_Yoneda_is_ntcf:
  assumes "𝒵 β" and "α ∈∘ β" 
  shows "ntcf_Yoneda α β ℭ :
    cf_nt α β (cf_id ℭ) ↦CF.iso cf_eval α β ℭ :
    cat_FUNCT α ℭ (cat_Set α) ×C ℭ ↦↦C⇘β⇙ cat_Set β"
proof-

  interpret β: 𝒵 β by (rule assms(1))
  interpret βℭ: category β ℭ
    by (rule category.cat_category_if_ge_Limit)
      (use assms(2) in ‹cs_concl cs_shallow cs_intro: cat_cs_intros›)+
  from assms(2) interpret FUNCT: category β ‹cat_FUNCT α ℭ (cat_Set α)›
    by 
      (
        cs_concl cs_shallow 
          cs_intro: cat_cs_intros cat_small_cs_intros cat_FUNCT_cs_intros
      )

  show ?thesis
  proof(intro is_iso_ntcfI is_ntcfI')
    show "vfsequence (ntcf_Yoneda α β ℭ)" unfolding ntcf_Yoneda_def by simp
    show "vcard (ntcf_Yoneda α β ℭ) = 5ℕ"
      unfolding ntcf_Yoneda_def by (simp add: nat_omega_simps)
    show ntcf_Yoneda_𝔉r: "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉r⦈ :
      cf_nt α β (cf_id ℭ)⦇ObjMap⦈⦇𝔉r⦈ ↦iso⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔉r⦈"
      if "𝔉r ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈" for 𝔉r
    proof-
      from that obtain 𝔉 r 
        where 𝔉r_def: "𝔉r = [𝔉, r]∘" 
          and 𝔉: "𝔉 ∈∘ cf_maps α ℭ (cat_Set α)"
          and r: "r ∈∘ ℭ⦇Obj⦈"
        by
          (
            auto 
              elim: cat_prod_2_ObjE[rotated 2] 
              simp: cat_FUNCT_cs_simps
              intro: cat_cs_intros
           )
      from 𝔉 obtain 𝔊
        where 𝔉_def: "𝔉 = cf_map 𝔊" and 𝔊: "𝔊 : ℭ ↦↦C⇘α⇙ cat_Set α"
        by clarsimp
      from assms(2) 𝔊 r show ?thesis
        unfolding 𝔉r_def 𝔉_def 
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_arrow_cs_intros
           )      
    qed
    show "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉r⦈ :
      cf_nt α β (cf_id ℭ)⦇ObjMap⦈⦇𝔉r⦈ ↦⇘cat_Set β⇙ cf_eval α β ℭ⦇ObjMap⦈⦇𝔉r⦈"
      if "𝔉r ∈∘ (cat_FUNCT α ℭ (cat_Set α) ×C ℭ)⦇Obj⦈" for 𝔉r
      by (rule is_iso_arrD[OF ntcf_Yoneda_𝔉r[OF that]])
    show 
      "ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔊b⦈ ∘A⇘cat_Set β⇙ 
        cf_nt α β (cf_id ℭ)⦇ArrMap⦈⦇𝔑f⦈ =
          cf_eval α β ℭ⦇ArrMap⦈⦇𝔑f⦈ ∘A⇘cat_Set β⇙ 
            ntcf_Yoneda α β ℭ⦇NTMap⦈⦇𝔉a⦈"
      if 𝔑f: "𝔑f : 𝔉a ↦⇘cat_FUNCT α ℭ (cat_Set α) ×C ℭ⇙ 𝔊b" for 𝔉a 𝔊b 𝔑f
    proof-
      obtain 𝔑 f 𝔉 a 𝔊 b
        where 𝔑f_def: "𝔑f = [𝔑, f]∘" 
          and 𝔉a_def: "𝔉a = [𝔉, a]∘"
          and 𝔊b_def: "𝔊b = [𝔊, b]∘" 
          and 𝔑: "𝔑 : 𝔉 ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ 𝔊" 
          and f: "f : a ↦⇘ℭ⇙ b"
        by 
          (
            auto intro: 
              cat_prod_2_is_arrE[rotated 2, OF 𝔑f] 
              FUNCT.category_axioms 
              βℭ.category_axioms
          )
      note 𝔑 = cat_FUNCT_is_arrD[OF 𝔑]
      note [cat_cs_simps] = 
        cat_ntcf_Yoneda_arrow_commute[OF assms 𝔑(1) f, folded 𝔑(2,3,4)]
      from 𝔑(1) assms(2) f show ?thesis
        unfolding 𝔑f_def 𝔉a_def 𝔊b_def
        by (subst (1 2) 𝔑(2), use nothing in ‹subst 𝔑(3), subst 𝔑(4)›)
          (
            cs_concl 
              cs_simp: 𝔑(2,3,4)[symmetric] cat_cs_simps cs_intro: cat_cs_intros
          )+
    qed

  qed (use assms(2) in ‹cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros›)+

qed



subsection‹‹Hom›-map›

text‹
This subsection presents some of the results stated as Corollary 2 
in subsection 1.15 in cite‹"bodo_categories_1970"› and the corollary 
following the statement of the Yoneda Lemma on 
page 61 in cite‹"mac_lane_categories_2010"› in a variety of forms.
›


subsubsection‹Definition and elementary properties›


text‹
The following function makes an explicit appearance in subsection 1.15 in 
cite‹"bodo_categories_1970"›.
›

definition ntcf_Hom_map :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "ntcf_Hom_map α ℭ a b = (λf∈∘Hom ℭ a b. HomA.C⇘α⇙ℭ(f,-))"


text‹Elementary properties.›

mk_VLambda ntcf_Hom_map_def
  |vsv ntcf_Hom_map_vsv|
  |vdomain ntcf_Hom_map_vdomain[cat_cs_simps]|
  |app ntcf_Hom_map_app[unfolded in_Hom_iff, cat_cs_simps]|


subsubsection‹‹Hom›-map is a bijection›

lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique:
  ―‹The following lemma approximately corresponds to the corollary on 
page 61 in \cite{mac_lane_categories_2010}.›
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.C⇘α⇙ℭ(r,-) ↦CF HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈ : s ↦⇘ℭ⇙ r"
    and "𝔑 = HomA.C⇘α⇙ℭ(Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈,-)"
    and "⋀f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.C⇘α⇙ℭ(f,-) ⟧ ⟹
      f = Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈"
proof-

  interpret 𝔑: is_ntcf α ℭ ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(r,-)› ‹HomO.C⇘α⇙ℭ(s,-)› 𝔑
    by (rule assms(3))
  let ?Y_Hom_s = ‹Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r›
  note Yoneda = 
    cat_Yoneda_Lemma[OF cat_cf_Hom_snd_is_functor[OF assms(2)] assms(1)]
  interpret Y: v11 ‹?Y_Hom_s› by (rule Yoneda(1))

  from category_axioms assms have 𝔑_in_vdomain: "𝔑 ∈∘ 𝒟∘ (?Y_Hom_s)" 
    by (cs_concl cs_shallow cs_simp: these_ntcfs_iff cat_cs_simps cs_intro: cat_cs_intros) 
  then have "?Y_Hom_s⦇𝔑⦈ ∈∘ ℛ∘ (?Y_Hom_s)" by (simp add: Y.vsv_vimageI2)
  from this category_axioms assms show Ym_𝔑: "?Y_Hom_s⦇𝔑⦈ : s ↦⇘ℭ⇙ r"
    unfolding Yoneda(2) 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cat_op_simps) 
  then have "?Y_Hom_s⦇𝔑⦈ ∈∘ ℭ⦇Arr⦈" by (simp add: cat_cs_intros)

  have "HomA.C⇘α⇙ℭ(?Y_Hom_s⦇𝔑⦈,-) :
    HomO.C⇘α⇙ℭ(r,-) ↦CF HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (intro cat_ntcf_Hom_snd_is_ntcf Ym_𝔑)

  from assms Ym_𝔑 this category_axioms assms have 
    "(?Y_Hom_s)¯∘⦇?Y_Hom_s⦇𝔑⦈⦈ =
      Yoneda_arrow α HomO.C⇘α⇙ℭ(s,-) r (?Y_Hom_s⦇𝔑⦈)"
    by (intro category.inv_Yoneda_map_app)
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
      ) 
  then have "(?Y_Hom_s)¯∘⦇?Y_Hom_s⦇𝔑⦈⦈ = HomA.C⇘α⇙ℭ(?Y_Hom_s⦇𝔑⦈,-)"
    by (simp add: ntcf_Hom_snd_def'[OF Ym_𝔑])
  with 𝔑_in_vdomain show "𝔑 = HomA.C⇘α⇙ℭ(?Y_Hom_s⦇𝔑⦈,-)" by auto

  fix f assume prems: "f ∈∘ ℭ⦇Arr⦈" "𝔑 = HomA.C⇘α⇙ℭ(f,-)"
  then obtain a b where f: "f : a ↦⇘ℭ⇙ b" by auto

  have "𝔑 : HomO.C⇘α⇙ℭ(b,-) ↦CF HomO.C⇘α⇙ℭ(a,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by (rule cat_ntcf_Hom_snd_is_ntcf[OF f, folded prems(2)])
  with f 𝔑.ntcf_NTDom 𝔑.ntcf_NTCod assms cat_is_arrD(2,3)[OF f] 
  have ba_simps: "b = r" "a = s"
    by 
      (
        simp_all add: 
          prems(2) cat_cf_Hom_snd_inj cat_ntcf_Hom_snd_components(2,3)
      )
  from f have "f : s ↦⇘ℭ⇙ r" unfolding ba_simps .

  with category_axioms show "f = ?Y_Hom_s⦇𝔑⦈"
    unfolding prems(2) 
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_op_simps)

qed

lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique:
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.C⇘α⇙ℭ(-,r) ↦CF HomO.C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇𝔑⦈ : r ↦⇘ℭ⇙ s"
    and "𝔑 = HomA.C⇘α⇙ℭ(-,Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇𝔑⦈)"
    and "⋀f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.C⇘α⇙ℭ(-,f) ⟧ ⟹
      f = Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇𝔑⦈"
  by 
    (
      intro  
        category.cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[
          OF category_op, 
          unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd, 
          OF assms(1,2), 
          unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
          OF assms(3)
          ]
    )+

lemma (in category) cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique':
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.C⇘α⇙ℭ(r,-) ↦CF HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "∃!f. f ∈∘ ℭ⦇Arr⦈ ∧ 𝔑 = HomA.C⇘α⇙ℭ(f,-)"
  using cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms] by blast

lemma (in category) cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique':
  assumes "r ∈∘ ℭ⦇Obj⦈"
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.C⇘α⇙ℭ(-,r) ↦CF HomO.C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "∃!f. f ∈∘ ℭ⦇Arr⦈ ∧ 𝔑 = HomA.C⇘α⇙ℭ(-,f)"
  using cat_ntcf_Hom_fst_is_ntcf_Hom_fst_unique[OF assms] by blast

lemma (in category) cat_ntcf_Hom_snd_inj:
  assumes "HomA.C⇘α⇙ℭ(g,-) = HomA.C⇘α⇙ℭ(f,-)" 
    and "g : a ↦⇘ℭ⇙ b" 
    and "f : a ↦⇘ℭ⇙ b" 
  shows "g = f"
proof-
  from assms have 
    "Yoneda_map α (HomO.C⇘α⇙ℭ(a,-)) b⦇HomA.C⇘α⇙ℭ(g,-)⦈ =
      Yoneda_map α (HomO.C⇘α⇙ℭ(a,-)) b⦇HomA.C⇘α⇙ℭ(f,-)⦈"
    by simp
  from this assms category_axioms show "g = f"
    by 
      (
        cs_prems cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
      ) 
      simp (*slow*)
qed

lemma (in category) cat_ntcf_Hom_fst_inj:
  assumes "HomA.C⇘α⇙ℭ(-,g) = HomA.C⇘α⇙ℭ(-,f)" 
    and "g : a ↦⇘ℭ⇙ b" 
    and "f : a ↦⇘ℭ⇙ b" 
  shows "g = f"
proof-
  from category.cat_ntcf_Hom_snd_inj
    [
      OF category_op, 
      unfolded cat_op_simps,
      unfolded cat_op_cat_ntcf_Hom_snd,
      OF assms
    ]
  show ?thesis .
qed

lemma (in category) cat_ntcf_Hom_map: 
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "v11 (ntcf_Hom_map α ℭ a b)" 
    and "ℛ∘ (ntcf_Hom_map α ℭ a b) =
      these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-)"
    and "(ntcf_Hom_map α ℭ a b)¯∘ =
      (λ𝔑∈∘these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-).
        Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈)"
proof-

  show "v11 (ntcf_Hom_map α ℭ a b)"
  proof(rule vsv.vsv_valeq_v11I, unfold ntcf_Hom_map_vdomain in_Hom_iff)
    show "vsv (ntcf_Hom_map α ℭ a b)" unfolding ntcf_Hom_map_def by simp
    fix g f assume prems: 
      "g : a ↦⇘ℭ⇙ b" 
      "f : a ↦⇘ℭ⇙ b"
      "ntcf_Hom_map α ℭ a b⦇g⦈ = ntcf_Hom_map α ℭ a b⦇f⦈"
    from prems(3,1,2) have "HomA.C⇘α⇙ℭ(g,-) = HomA.C⇘α⇙ℭ(f,-)"
      by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    with prems(1,2) show "g = f" by (intro cat_ntcf_Hom_snd_inj[of g f])
  qed
  then interpret Hm: v11 ‹ntcf_Hom_map α ℭ a b› .

  show Hm_vrange: "ℛ∘ (ntcf_Hom_map α ℭ a b) =
    these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-)"
  proof(intro vsubset_antisym)
    show "ℛ∘ (ntcf_Hom_map α ℭ a b) ⊆∘
      these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-)"
      by 
        (
          unfold ntcf_Hom_map_def,
          intro vrange_VLambda_vsubset, 
          unfold these_ntcfs_iff in_Hom_iff, 
          intro cat_ntcf_Hom_snd_is_ntcf
        )
    show "these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-) ⊆∘
      ℛ∘ (ntcf_Hom_map α ℭ a b)"
    proof(intro vsubsetI, unfold these_ntcfs_iff)
      fix 𝔑 assume prems: 
        "𝔑 : HomO.C⇘α⇙ℭ(b,-) ↦CF HomO.C⇘α⇙ℭ(a,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
      note unique = 
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
      from unique(1) have 
        "Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈ ∈∘ 𝒟∘ (ntcf_Hom_map α ℭ a b)"
        by (cs_concl cs_simp: cat_cs_simps)
      moreover from 
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF assms(2,1) prems] 
      have 𝔑_def: "𝔑 = ntcf_Hom_map α ℭ a b⦇Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈⦈"
        by (cs_concl cs_shallow cs_simp: cat_cs_simps)
      ultimately show "𝔑 ∈∘ ℛ∘ (ntcf_Hom_map α ℭ a b)" by force
    qed 
  qed

  show "(ntcf_Hom_map α ℭ a b)¯∘ =
    (
      λ𝔑∈∘these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-).
        Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈
    )"
  proof
    (
      rule vsv_eqI, 
      unfold vdomain_vconverse vdomain_VLambda Hm_vrange these_ntcfs_iff
    )

    from Hm.v11_axioms show "vsv ((ntcf_Hom_map α ℭ a b)¯∘)" by auto
    show "vsv 
      (
        λ𝔑∈∘these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-).
          Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈
      )"
      by simp

    fix 𝔑 assume prems: 
      "𝔑 : HomO.C⇘α⇙ℭ(b,-) ↦CF HomO.C⇘α⇙ℭ(a,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    then have 𝔑: 
      "𝔑 ∈∘ these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-)"
      unfolding these_ntcfs_iff by simp
    show "(ntcf_Hom_map α ℭ a b)¯∘⦇𝔑⦈ =
      (
        λ𝔑∈∘these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-).
          Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈
      )⦇𝔑⦈"
    proof
      (
        intro Hm.v11_vconverse_app, 
        unfold ntcf_Hom_map_vdomain in_Hom_iff beta[OF 𝔑]
      )
      note unique = 
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) prems]
      show "Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈ : a ↦⇘ℭ⇙ b" by (rule unique(1))
      then show 
        "ntcf_Hom_map α ℭ a b⦇Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈⦈ = 𝔑"
        by (cs_concl cs_simp: unique(2)[symmetric] cat_cs_simps)
    qed

  qed simp

qed


subsubsection‹Inverse of a ‹Hom›-map›

lemma (in category) inv_ntcf_Hom_map_v11: 
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "v11 ((ntcf_Hom_map α ℭ a b)¯∘)"
  using cat_ntcf_Hom_map(1)[OF assms] by (simp add: v11.v11_vconverse)

lemma (in category) inv_ntcf_Hom_map_vdomain: 
  assumes "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈"
  shows "𝒟∘ ((ntcf_Hom_map α ℭ a b)¯∘) =
    these_ntcfs α ℭ (cat_Set α) HomO.C⇘α⇙ℭ(b,-) HomO.C⇘α⇙ℭ(a,-)"
  unfolding cat_ntcf_Hom_map(3)[OF assms] by simp

lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_vdomain

lemma (in category) inv_ntcf_Hom_map_app: 
  assumes "a ∈∘ ℭ⦇Obj⦈" 
    and "b ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.C⇘α⇙ℭ(b,-) ↦CF HomO.C⇘α⇙ℭ(a,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "(ntcf_Hom_map α ℭ a b)¯∘⦇𝔑⦈ = Yoneda_map α HomO.C⇘α⇙ℭ(a,-) b⦇𝔑⦈"
  using assms(3) unfolding cat_ntcf_Hom_map(3)[OF assms(1,2)] by simp

lemmas [cat_cs_simps] = category.inv_ntcf_Hom_map_app

lemma inv_ntcf_Hom_map_vrange: "ℛ∘ ((ntcf_Hom_map α ℭ a b)¯∘) = Hom ℭ a b"
  unfolding ntcf_Hom_map_def by simp


subsubsection‹‹Hom›-natural transformation and isomorphisms›


text‹
This subsection presents further results that were stated 
as Corollary 2 in subsection 1.15 in cite‹"bodo_categories_1970"›.
›

lemma (in category) cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf:
  assumes "f : s ↦iso⇘ℭ⇙ r"
  shows "HomA.C⇘α⇙ℭ(f,-) :
    HomO.C⇘α⇙ℭ(r,-) ↦CF.iso HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  from assms obtain g 
    where iso_g: "g : r ↦iso⇘ℭ⇙ s" 
      and gf: "g ∘A⇘ℭ⇙ f = ℭ⦇CId⦈⦇s⦈"
      and fg: "f ∘A⇘ℭ⇙ g = ℭ⦇CId⦈⦇r⦈"
    by 
      (
        auto intro:
          cat_the_inverse_Comp_CId_left 
          cat_the_inverse_Comp_CId_right 
          cat_the_inverse_is_iso_arr'
      )
  then have g: "g : r ↦⇘ℭ⇙ s" by auto
  show ?thesis
  proof(intro is_iso_arr_is_iso_ntcf)
    from assms have f: "f : s ↦⇘ℭ⇙ r" by auto
    with category_axioms show "HomA.C⇘α⇙ℭ(f,-) :
      HomO.C⇘α⇙ℭ(r,-) ↦CF HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros) 
    from category_axioms g show "HomA.C⇘α⇙ℭ(g,-) :
      HomO.C⇘α⇙ℭ(s,-) ↦CF HomO.C⇘α⇙ℭ(r,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)    
    from category_axioms f g have 
      "HomA.C⇘α⇙ℭ(f,-) ∙NTCF HomA.C⇘α⇙ℭ(g,-) = HomA.C⇘α⇙ℭ(g ∘A⇘ℭ⇙ f,-)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    also from category_axioms f g have "… = ntcf_id HomO.C⇘α⇙ℭ(s,-)"
      by (cs_concl cs_simp: gf cat_cs_simps cs_intro: cat_cs_intros)
    finally show 
      "HomA.C⇘α⇙ℭ(f,-) ∙NTCF HomA.C⇘α⇙ℭ(g,-) = ntcf_id HomO.C⇘α⇙ℭ(s,-)"
      by simp
    from category_axioms f g have 
      "HomA.C⇘α⇙ℭ(g,-) ∙NTCF HomA.C⇘α⇙ℭ(f,-) = HomA.C⇘α⇙ℭ(f ∘A⇘ℭ⇙ g,-)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    also from category_axioms f g have "… = ntcf_id HomO.C⇘α⇙ℭ(r,-)"
      by (cs_concl cs_simp: fg cat_cs_simps cs_intro: cat_cs_intros)
    finally show 
      "HomA.C⇘α⇙ℭ(g,-) ∙NTCF HomA.C⇘α⇙ℭ(f,-) = ntcf_id HomO.C⇘α⇙ℭ(r,-)"
      by simp
  qed
qed

lemma (in category) cat_is_iso_arr_ntcf_Hom_fst_is_iso_ntcf:
  assumes "f : r ↦iso⇘ℭ⇙ s"
  shows "HomA.C⇘α⇙ℭ(-,f) :
    HomO.C⇘α⇙ℭ(-,r) ↦CF.iso HomO.C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  from assms have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  from 
    category.cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf
      [
        OF category_op, 
        unfolded cat_op_simps,
        OF assms,
        unfolded
          category.cat_op_cat_cf_Hom_snd[OF category_axioms r]
          category.cat_op_cat_cf_Hom_snd[OF category_axioms s]
          category.cat_op_cat_ntcf_Hom_snd[OF category_axioms]
      ]
  show ?thesis.
qed

lemma (in category) cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique:
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : HomO.C⇘α⇙ℭ(r,-) ↦CF.iso HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈ : s ↦iso⇘ℭ⇙ r"
    and "𝔑 = HomA.C⇘α⇙ℭ(Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈,-)"
    and "⋀f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.C⇘α⇙ℭ(f,-) ⟧ ⟹
      f = Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈"
proof-

  let ?Ym_𝔑 = ‹Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈›
    and ?Ym_inv_𝔑 = ‹Yoneda_map α HomO.C⇘α⇙ℭ(r,-) s⦇inv_ntcf 𝔑⦈›

  from assms(3) have 𝔑:
    "𝔑 : HomO.C⇘α⇙ℭ(r,-) ↦CF HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by auto
  from iso_ntcf_is_iso_arr[OF assms(3)] 
  have iso_inv_𝔑: "inv_ntcf 𝔑 : 
    HomO.C⇘α⇙ℭ(s,-) ↦CF.iso HomO.C⇘α⇙ℭ(r,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    and [simp]: "𝔑 ∙NTCF inv_ntcf 𝔑 = ntcf_id HomO.C⇘α⇙ℭ(s,-)"
    and [simp]: "inv_ntcf 𝔑 ∙NTCF 𝔑 = ntcf_id HomO.C⇘α⇙ℭ(r,-)"
    by auto
  from iso_inv_𝔑 have inv_𝔑: 
    "inv_ntcf 𝔑 : HomO.C⇘α⇙ℭ(s,-) ↦CF HomO.C⇘α⇙ℭ(r,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
    by auto 
  note unique = cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(1,2) 𝔑]
    and inv_unique = 
    cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique[OF assms(2,1) inv_𝔑]
  have Ym_𝔑: "?Ym_𝔑 : s ↦⇘ℭ⇙ r" by (rule unique(1))

  show "𝔑 = HomA.C⇘α⇙ℭ(Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈,-)"
    and "⋀f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.C⇘α⇙ℭ(f,-) ⟧ ⟹
      f = Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈"
    by (intro unique)+

  show "Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇𝔑⦈ : s ↦iso⇘ℭ⇙ r"
  proof(intro is_iso_arrI[OF Ym_𝔑, of ‹?Ym_inv_𝔑›] is_inverseI)

    show Ym_inv_𝔑: "?Ym_inv_𝔑 : r ↦⇘ℭ⇙ s" by (rule inv_unique(1))
    
    have "ntcf_id HomO.C⇘α⇙ℭ(s,-) = 𝔑 ∙NTCF inv_ntcf 𝔑" by simp
    also have "… = HomA.C⇘α⇙ℭ(?Ym_𝔑,-) ∙NTCF HomA.C⇘α⇙ℭ(?Ym_inv_𝔑,-)"
      by (subst unique(2), subst inv_unique(2)) simp
    also from category_axioms Ym_𝔑 inv_unique(1) assms(3) have 
      "… = HomA.C⇘α⇙ℭ(?Ym_inv_𝔑 ∘A⇘ℭ⇙ ?Ym_𝔑,-)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    finally have "HomA.C⇘α⇙ℭ(?Ym_inv_𝔑 ∘A⇘ℭ⇙ ?Ym_𝔑,-) = ntcf_id HomO.C⇘α⇙ℭ(s,-)"
      by simp
    also from category_axioms assms(1,2) have "… = HomA.C⇘α⇙ℭ(ℭ⦇CId⦈⦇s⦈,-)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    finally have "HomA.C⇘α⇙ℭ(?Ym_inv_𝔑 ∘A⇘ℭ⇙ ?Ym_𝔑,-) = HomA.C⇘α⇙ℭ(ℭ⦇CId⦈⦇s⦈,-)"
      by simp
    then show "?Ym_inv_𝔑 ∘A⇘ℭ⇙ ?Ym_𝔑 = ℭ⦇CId⦈⦇s⦈"
      by (rule cat_ntcf_Hom_snd_inj)
        (
          all‹
            use category_axioms Ym_𝔑 Ym_inv_𝔑 assms in 
              ‹cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
            ›
        )
    have "ntcf_id HomO.C⇘α⇙ℭ(r,-) = inv_ntcf 𝔑 ∙NTCF 𝔑" by simp
    also have "… = HomA.C⇘α⇙ℭ(?Ym_inv_𝔑,-) ∙NTCF HomA.C⇘α⇙ℭ(?Ym_𝔑,-)"
      by (subst unique(2), subst inv_unique(2)) simp
    also from category_axioms Ym_𝔑 inv_unique(1) have 
      "… = HomA.C⇘α⇙ℭ(?Ym_𝔑 ∘A⇘ℭ⇙ ?Ym_inv_𝔑,-)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)
    finally have 
      "HomA.C⇘α⇙ℭ(?Ym_𝔑 ∘A⇘ℭ⇙ ?Ym_inv_𝔑,-) = ntcf_id HomO.C⇘α⇙ℭ(r,-)"
      by simp
    also from category_axioms assms(1,2) have "… = HomA.C⇘α⇙ℭ(ℭ⦇CId⦈⦇r⦈,-)"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    finally have 
      "HomA.C⇘α⇙ℭ(?Ym_𝔑 ∘A⇘ℭ⇙ ?Ym_inv_𝔑,-) = HomA.C⇘α⇙ℭ(ℭ⦇CId⦈⦇r⦈,-)"
      by simp
    then show "?Ym_𝔑 ∘A⇘ℭ⇙ ?Ym_inv_𝔑 = ℭ⦇CId⦈⦇r⦈"
      by (rule cat_ntcf_Hom_snd_inj)
        (
          all‹
            use category_axioms Ym_𝔑 Ym_inv_𝔑 assms in 
              ‹cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros›
            ›
        )

  qed (intro Ym_𝔑)

qed

lemma (in category) cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique:
  assumes "r ∈∘ ℭ⦇Obj⦈" 
    and "s ∈∘ ℭ⦇Obj⦈"
    and "𝔑 : 
    HomO.C⇘α⇙ℭ(-,r) ↦CF.iso HomO.C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇𝔑⦈ : r ↦iso⇘ℭ⇙ s"
    and "𝔑 = HomA.C⇘α⇙ℭ(-,Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇𝔑⦈)"
    and "⋀f. ⟦ f ∈∘ ℭ⦇Arr⦈; 𝔑 = HomA.C⇘α⇙ℭ(-,f) ⟧ ⟹
      f = Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇𝔑⦈"
  by 
    (
      intro  
        category.cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[
          OF category_op, 
          unfolded cat_op_simps cat_op_cat_ntcf_Hom_snd, 
          OF assms(1,2), 
          unfolded assms(1,2)[THEN cat_op_cat_cf_Hom_snd],
          OF assms(3)
          ]
    )+

lemma (in category) cat_is_iso_arr_if_ntcf_Hom_snd_is_iso_ntcf:
  assumes "f : s ↦⇘ℭ⇙ r"
    and "HomA.C⇘α⇙ℭ(f,-) :
      HomO.C⇘α⇙ℭ(r,-) ↦CF.iso HomO.C⇘α⇙ℭ(s,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "f : s ↦iso⇘ℭ⇙ r"
proof-
  from assms(1) have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  note unique = cat_ntcf_Hom_snd_is_iso_ntcf_Hom_snd_unique[OF r s assms(2)]
  from unique(1) have Ym_Hf: 
    "Yoneda_map α HomO.C⇘α⇙ℭ(s,-) r⦇HomA.C⇘α⇙ℭ(f,-)⦈ : s ↦⇘ℭ⇙ r"
    by auto
  from unique(1) show ?thesis
    unfolding cat_ntcf_Hom_snd_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
    by simp
qed

lemma (in category) cat_is_iso_arr_if_ntcf_Hom_fst_is_iso_ntcf:
  assumes "f : r ↦⇘ℭ⇙ s"
    and "HomA.C⇘α⇙ℭ(-,f) :
      HomO.C⇘α⇙ℭ(-,r) ↦CF.iso HomO.C⇘α⇙ℭ(-,s) : op_cat ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "f : r ↦iso⇘ℭ⇙ s"
proof-
  from assms(1) have r: "r ∈∘ ℭ⦇Obj⦈" and s: "s ∈∘ ℭ⦇Obj⦈" by auto
  note unique = cat_ntcf_Hom_fst_is_iso_ntcf_Hom_fst_unique[OF r s assms(2)]
  from unique(1) have Ym_Hf: 
    "Yoneda_map α HomO.C⇘α⇙ℭ(-,s) r⦇HomA.C⇘α⇙ℭ(-,f)⦈ : r ↦⇘ℭ⇙ s"
    by auto
  from unique(1) show ?thesis
    unfolding cat_ntcf_Hom_fst_inj[OF unique(2) assms(1) Ym_Hf, symmetric]
    by simp
qed


subsubsection‹
The relationship between a ‹Hom›-natural transformation and the compositions 
of a ‹Hom›-natural transformation and a natural transformation
›

lemma (in category) cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "b ∈∘ 𝔅⦇Obj⦈"
    and "c ∈∘ ℭ⦇Obj⦈"
  shows "HomA.C⇘α⇙(φ-,-)⦇NTMap⦈⦇b, c⦈∙ = HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇c⦈"
proof-      
  interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from assms(2) have b: "b ∈∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by simp
  from category_axioms assms(1,3) b show ?thesis
    by 
      (
        cs_concl cs_shallow
          cs_simp: 
            cat_ntcf_lcomp_Hom_component_is_Yoneda_component cat_cs_simps 
          cs_intro: cat_cs_intros cat_op_intros
      )
qed

lemmas [cat_cs_simps] = category.cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app

lemma (in category) cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomA.C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)NTCF = HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)"
proof-
  interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))  
  show ?thesis
  proof(rule ntcf_eqI[of α])
    from category_axioms assms show 
      "HomA.C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)NTCF : 
      HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) : 
      ℭ ↦↦C⇘α⇙ cat_Set α"      
      by 
        (
          cs_concl cs_shallow 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
        )
    from assms this have dom_lhs:
      "𝒟∘ ((HomA.C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)NTCF)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from category_axioms assms show 
      "HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
        HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
        ℭ ↦↦C⇘α⇙ cat_Set α"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    from assms this have dom_rhs: 
      "𝒟∘ (HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈) = ℭ⦇Obj⦈"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    show 
      "(HomA.C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)NTCF)⦇NTMap⦈ = 
        HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a ∈∘ ℭ⦇Obj⦈"
      with category_axioms assms show
        "(HomA.C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)NTCF)⦇NTMap⦈⦇a⦈ =
          HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇a⦈"
        by (cs_concl cs_simp: cat_cs_simps) 
    qed (use assms(2) in ‹auto intro: cat_cs_intros›)
  qed simp_all
qed

lemmas [cat_cs_simps] = category.cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd


subsubsection‹
The relationship between the ‹Hom›-natural isomorphisms and the compositions
of a ‹Hom›-natural isomorphism and a natural transformation
›

lemma (in category) cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "⋀b. b ∈∘ 𝔅⦇Obj⦈ ⟹ HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
      HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
      ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "HomA.C⇘α⇙(φ-,-) :
    HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉-,-) :
    op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
  have "HomA.C⇘α⇙(φ-,-)⇘op_cat 𝔅,ℭ⇙(b,-)NTCF : 
    HomO.C⇘α⇙ℭ(𝔊-,-)⇘op_cat 𝔅,ℭ⇙(b,-)CF ↦CF.iso 
    HomO.C⇘α⇙ℭ(𝔉-,-)⇘op_cat 𝔅,ℭ⇙(b,-)CF : 
    ℭ ↦↦C⇘α⇙ cat_Set α"
    if "b ∈∘ 𝔅⦇Obj⦈" for b
    unfolding 
      cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1) that]
      cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTDom.is_functor_axioms that]
      cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTCod.is_functor_axioms that]
    by (intro assms(2) that)
  from 
    is_iso_ntcf_if_bnt_proj_snd_is_iso_ntcf[
      OF 
        φ.NTDom.HomDom.category_op category_axioms 
        cat_ntcf_lcomp_Hom_is_ntcf[OF assms(1)], 
      unfolded cat_op_simps, OF this
      ]
  show ?thesis .
qed

lemma (in category) cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf:
  assumes "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "HomA.C⇘α⇙(φ-,-) :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    and "b ∈∘ 𝔅⦇Obj⦈"
  shows "HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
    HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
    ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
  from category_axioms assms show ?thesis
    by  
      (
        fold 
          cat_bnt_proj_snd_tcf_lcomp_Hom_ntcf_Hom_snd[OF assms(1,3)]
          cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTDom.is_functor_axioms assms(3)]
          cat_cf_lcomp_Hom_cf_Hom_snd[OF φ.NTCod.is_functor_axioms assms(3)],
        intro bnt_proj_snd_is_iso_ntcf_if_is_iso_ntcf
      )    
      (cs_concl cs_shallow cs_simp: cat_op_simps cs_intro: cat_cs_intros)
qed



subsection‹Yoneda map for arbitrary functors›


text‹
The concept of the Yoneda map for arbitrary functors was developed based
on the function that was used in the statement of Lemma 3 in 
subsection 1.15 in cite‹"bodo_categories_1970"›.
›

definition af_Yoneda_map :: "V ⇒ V ⇒ V ⇒ V"
  where "af_Yoneda_map α 𝔉 𝔊 =
    (λφ∈∘these_ntcfs α (𝔉⦇HomDom⦈) (𝔉⦇HomCod⦈) 𝔉 𝔊. HomA.C⇘α⇙(φ-,-))"


text‹Elementary properties.›

context
  fixes α 𝔅 ℭ 𝔉 𝔊
  assumes 𝔉: "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and 𝔊: "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
begin

interpretation 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule 𝔉)
interpretation 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule 𝔊)

mk_VLambda 
  af_Yoneda_map_def[where 𝔉=𝔉 and 𝔊=𝔊, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
  |vsv af_Yoneda_map_vsv|
  |vdomain af_Yoneda_map_vdomain[cat_cs_simps]|
  |app af_Yoneda_map_app[unfolded these_ntcfs_iff, cat_cs_simps]|

end



subsection‹Yoneda arrow for arbitrary functors›


subsubsection‹Definition and elementary properties›


text‹
The following natural transformation is used in the proof of Lemma 3 in 
subsection 1.15 in cite‹"bodo_categories_1970"›.
›

definition af_Yoneda_arrow :: "V ⇒ V ⇒ V ⇒ V ⇒ V"
  where "af_Yoneda_arrow α 𝔉 𝔊 𝔑 =
    [
      (
        λb∈∘(𝔉⦇HomDom⦈)⦇Obj⦈.
          Yoneda_map α HomO.C⇘α⇙𝔉⦇HomCod⦈(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇
            𝔑⇘op_cat (𝔉⦇HomDom⦈),𝔉⦇HomCod⦈⇙(b,-)NTCF
            ⦈
      ),
      𝔉,
      𝔊,
      𝔉⦇HomDom⦈,
      𝔉⦇HomCod⦈
    ]∘"


text‹Components.›

lemma af_Yoneda_arrow_components:
  shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈ =
      (
        λb∈∘𝔉⦇HomDom⦈⦇Obj⦈.
          Yoneda_map α HomO.C⇘α⇙𝔉⦇HomCod⦈(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇
            𝔑⇘op_cat (𝔉⦇HomDom⦈),𝔉⦇HomCod⦈⇙(b,-)NTCF
            ⦈
      )"
    and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTDom⦈ = 𝔉"
    and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTCod⦈ = 𝔊"
    and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTDGDom⦈ = 𝔉⦇HomDom⦈"
    and "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTDGCod⦈ = 𝔉⦇HomCod⦈"
  unfolding af_Yoneda_arrow_def nt_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Natural transformation map›

mk_VLambda af_Yoneda_arrow_components(1)
  |vsv af_Yoneda_arrow_NTMap_vsv|

context
  fixes α 𝔅 ℭ 𝔉
  assumes 𝔉: "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
begin

interpretation 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule 𝔉)

mk_VLambda 
  af_Yoneda_arrow_components(1)[where 𝔉=𝔉, unfolded 𝔉.cf_HomDom 𝔉.cf_HomCod]
  |vdomain af_Yoneda_arrow_NTMap_vdomain[cat_cs_simps]|
  |app af_Yoneda_arrow_NTMap_app[cat_cs_simps]|

end

lemma (in category) cat_af_Yoneda_arrow_is_ntcf:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔑 :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
proof-

  let ?H𝔊 = ‹HomO.C⇘α⇙ℭ(𝔊-,-)›
    and ?H𝔉 = ‹HomO.C⇘α⇙ℭ(𝔉-,-)›
    and ?Set = ‹cat_Set α›
    and ?Ym = 
      ‹
        λb. Yoneda_map
          α HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇𝔑⇘op_cat 𝔅,ℭ⇙(b,-)NTCF⦈
      ›

  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
  interpret 𝔑: is_ntcf 
    α ‹op_cat 𝔅 ×C ℭ› ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(𝔊-,-)› ‹HomO.C⇘α⇙ℭ(𝔉-,-)› 𝔑 
    by (rule assms)

  have comm[unfolded cat_op_simps]:
    "(𝔑⦇NTMap⦈⦇c, d⦈∙)⦇ArrVal⦈⦇f ∘A⇘ℭ⇙ (q ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈)⦈ =
      f ∘A⇘ℭ⇙ ((𝔑⦇NTMap⦈⦇a, b⦈∙)⦇ArrVal⦈⦇q⦈ ∘A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇g⦈)"
    if "g : a ↦⇘op_cat 𝔅⇙ c" and "f : b ↦⇘ℭ⇙ d" and "q : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ b" 
    for q g f a b c d
  proof-
    from that(1) have g: "g : c ↦⇘𝔅⇙ a" unfolding cat_op_simps by simp
    from category_axioms assms g that(2) have ab:
      "[a, b]∘ ∈∘ (op_cat 𝔅 ×C ℭ)⦇Obj⦈"
      by (cs_concl cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros)
    from 𝔑.ntcf_NTMap_is_arr[OF ab] category_axioms assms g that(2) have 𝔑ab: 
      "𝔑⦇NTMap⦈⦇a, b⦈∙ :
        Hom ℭ (𝔊⦇ObjMap⦈⦇a⦈) b ↦⇘cat_Set α⇙ Hom ℭ (𝔉⦇ObjMap⦈⦇a⦈) b"
      by 
        (
          cs_prems  
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
    have 𝔑_abq: "(𝔑⦇NTMap⦈⦇a, b⦈∙)⦇ArrVal⦈⦇q⦈ : 𝔉⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ b"
      by 
        (
          rule cat_Set_ArrVal_app_vrange[
            OF 𝔑ab, unfolded in_Hom_iff, OF that(3)
            ]
        )
    have "[g, f]∘ : [a, b]∘ ↦⇘op_cat 𝔅 ×C ℭ⇙ [c, d]∘"
      by 
        (
          rule 
            cat_prod_2_is_arrI[
              OF 𝔉.HomDom.category_op category_axioms that(1,2)
              ]
        )
    then have 
      "𝔑⦇NTMap⦈⦇c, d⦈∙ ∘A⇘cat_Set α⇙ HomO.C⇘α⇙ℭ(𝔊-,-)⦇ArrMap⦈⦇g, f⦈∙ =
        HomO.C⇘α⇙ℭ(𝔉-,-)⦇ArrMap⦈⦇g, f⦈∙ ∘A⇘cat_Set α⇙ 𝔑⦇NTMap⦈⦇a, b⦈∙"
      by (rule is_ntcf.ntcf_Comp_commute[OF assms(3)])
    then have 
      "(𝔑⦇NTMap⦈⦇c, d⦈∙ ∘A⇘?Set⇙ ?H𝔊⦇ArrMap⦈⦇g, f⦈∙)⦇ArrVal⦈⦇q⦈ =
        (?H𝔉⦇ArrMap⦈⦇g, f⦈∙ ∘A⇘?Set⇙ 𝔑⦇NTMap⦈⦇a, b⦈∙)⦇ArrVal⦈⦇q⦈"
      by auto

    from 
      this that(2,3) assms
      category_axioms 𝔉.HomDom.category_axioms 𝔉.HomDom.category_op category_op
      g 𝔑ab 𝔑_abq 
    show
      "(𝔑⦇NTMap⦈⦇c, d⦈∙)⦇ArrVal⦈⦇f ∘A⇘ℭ⇙ (q ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈)⦈ =
        f ∘A⇘ℭ⇙ ((𝔑⦇NTMap⦈⦇a, b⦈∙)⦇ArrVal⦈⦇q⦈ ∘A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇g⦈)" 
      by 
        (
          cs_prems 
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
        )
  qed

  show ?thesis
  proof(rule is_ntcfI')

    show "vfsequence (af_Yoneda_arrow α 𝔉 𝔊 𝔑)"
      unfolding af_Yoneda_arrow_def by simp
    show "vcard (af_Yoneda_arrow α 𝔉 𝔊 𝔑) = 5ℕ"
      unfolding af_Yoneda_arrow_def by (simp add: nat_omega_simps)

    have 𝔑b: "𝔑⇘op_cat 𝔅,ℭ⇙(b,-)NTCF :
      HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
      ℭ ↦↦C⇘α⇙ cat_Set α"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
      by 
        (
          rule 
            bnt_proj_snd_is_ntcf
              [
                OF 𝔉.HomDom.category_op category_axioms assms(3),
                unfolded cat_op_simps, 
                OF that,
                unfolded 
                  cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) that]
                  cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) that]
              ]
        )

    show "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
      if "b ∈∘ 𝔅⦇Obj⦈" for b
    proof-
      let ?𝔊b = ‹𝔊⦇ObjMap⦈⦇b⦈›
        and ?𝔉b = ‹𝔉⦇ObjMap⦈⦇b⦈›
        and ?ℭ𝔊b = ‹ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇b⦈⦈›
      from that have ℭ𝔊b: "?ℭ𝔊b : ?𝔊b ↦⇘ℭ⇙ ?𝔊b" by (auto simp: cat_cs_intros)
      from assms that have "[b, ?𝔊b]∘ ∈∘ (op_cat 𝔅 ×C ℭ)⦇Obj⦈"
        by 
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_b𝔊b: 
        "𝔑⦇NTMap⦈⦇b, ?𝔊b⦈∙ : Hom ℭ ?𝔊b ?𝔊b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉b ?𝔊b"
        by 
          (
            cs_prems cs_shallow
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from ℭ𝔊b have 𝔑_b𝔊b_ℭ𝔊b: 
        "(𝔑⦇NTMap⦈⦇b, ?𝔊b⦈∙)⦇ArrVal⦈⦇?ℭ𝔊b⦈ : ?𝔉b ↦⇘ℭ⇙ ?𝔊b"
        by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_b𝔊b, unfolded in_Hom_iff])
      with category_axioms assms that 𝔑b[OF that] show ?thesis
        by 
          (
            cs_concl cs_shallow 
              cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
          )
    qed

    show 
      "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇b⦈ ∘A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇f⦈ = 
        𝔊⦇ArrMap⦈⦇f⦈ ∘A⇘ℭ⇙ af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇a⦈"
      if "f : a ↦⇘𝔅⇙ b" for a b f
    proof-

      from that have a: "a ∈∘ 𝔅⦇Obj⦈" and b: "b ∈∘ 𝔅⦇Obj⦈" by auto
      
      let ?𝔅a = ‹𝔅⦇CId⦈⦇a⦈›
        and ?𝔅b = ‹𝔅⦇CId⦈⦇b⦈›
        and ?𝔊a = ‹𝔊⦇ObjMap⦈⦇a⦈›
        and ?𝔊b = ‹𝔊⦇ObjMap⦈⦇b⦈›
        and ?𝔉a = ‹𝔉⦇ObjMap⦈⦇a⦈›
        and ?𝔉b = ‹𝔉⦇ObjMap⦈⦇b⦈›
        and ?ℭ𝔊a = ‹ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇a⦈⦈›
        and ?ℭ𝔊b = ‹ℭ⦇CId⦈⦇𝔊⦇ObjMap⦈⦇b⦈⦈›

      from that have ℭ𝔊a: "?ℭ𝔊a : ?𝔊a ↦⇘ℭ⇙ ?𝔊a" by (auto intro: cat_cs_intros)
      from that have ℭ𝔊b: "?ℭ𝔊b : ?𝔊b ↦⇘ℭ⇙ ?𝔊b" by (auto intro: cat_cs_intros)
      from that have 𝔅a: "?𝔅a : a ↦⇘𝔅⇙ a" by (auto intro: cat_cs_intros)

      from assms that have "[b, ?𝔊b]∘ ∈∘ (op_cat 𝔅 ×C ℭ)⦇Obj⦈"
        by 
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_b𝔊b: 
        "𝔑⦇NTMap⦈⦇b, ?𝔊b⦈∙ : Hom ℭ ?𝔊b ?𝔊b ↦⇘cat_Set α⇙ Hom ℭ ?𝔉b ?𝔊b"
        by 
          (
            cs_prems cs_shallow
              cs_simp: cat_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from ℭ𝔊b have 𝔑_b𝔊b_ℭ𝔊b: 
        "(𝔑⦇NTMap⦈⦇b, ?𝔊b⦈∙)⦇ArrVal⦈⦇?ℭ𝔊b⦈ : ?𝔉b ↦⇘ℭ⇙ ?𝔊b"
        by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_b𝔊b, unfolded in_Hom_iff])

      from assms that have "[a, ?𝔊a]∘ ∈∘ (op_cat 𝔅 ×C ℭ)⦇Obj⦈"
        by 
          (
            cs_concl  
              cs_simp: cat_cs_simps 
              cs_intro: cat_cs_intros cat_op_intros cat_prod_cs_intros
          )
      from 𝔑.ntcf_NTMap_is_arr[OF this] category_axioms assms that have 𝔑_a𝔊a: 
        "𝔑⦇NTMap⦈⦇a, ?𝔊a⦈∙ : Hom ℭ ?𝔊a ?𝔊a ↦⇘cat_Set α⇙ Hom ℭ ?𝔉a ?𝔊a"
        by 
          (
            cs_prems  
              cs_simp: cat_cs_simps cat_op_simps 
              cs_intro: cat_cs_intros cat_prod_cs_intros
          )
      from ℭ𝔊a have 𝔑_a𝔊a_ℭ𝔊a: 
        "(𝔑⦇NTMap⦈⦇a, ?𝔊a⦈∙)⦇ArrVal⦈⦇?ℭ𝔊a⦈ : ?𝔉a ↦⇘ℭ⇙ ?𝔊a"
        by (rule cat_Set_ArrVal_app_vrange[OF 𝔑_a𝔊a, unfolded in_Hom_iff])

      from 
        comm[OF 𝔅a 𝔊.cf_ArrMap_is_arr[OF that] ℭ𝔊a] 
        category_axioms assms that 𝔑_a𝔊a_ℭ𝔊a
      have 𝔑_a_𝔊b[symmetric, cat_cs_simps]:
        "(𝔑⦇NTMap⦈⦇a, ?𝔊b⦈∙)⦇ArrVal⦈⦇𝔊⦇ArrMap⦈⦇f⦈⦈ =
          𝔊⦇ArrMap⦈⦇f⦈ ∘A⇘ℭ⇙ (𝔑⦇NTMap⦈⦇a, ?𝔊a⦈∙)⦇ArrVal⦈⦇?ℭ𝔊a⦈"
        by (cs_prems cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from comm[OF that ℭ𝔊b ℭ𝔊b] category_axioms assms that 𝔑_b𝔊b_ℭ𝔊b
      have 𝔑_a_𝔊b'[cat_cs_simps]:
        "(𝔑⦇NTMap⦈⦇a, ?𝔊b⦈∙)⦇ArrVal⦈⦇𝔊⦇ArrMap⦈⦇f⦈⦈ =
          (𝔑⦇NTMap⦈⦇b, ?𝔊b⦈∙)⦇ArrVal⦈⦇?ℭ𝔊b⦈ ∘A⇘ℭ⇙ 𝔉⦇ArrMap⦈⦇f⦈"
        by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)

      from category_axioms assms that 𝔑b[OF a] 𝔑b[OF b] show ?thesis
        by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros)

    qed

  qed (auto simp: af_Yoneda_arrow_components cat_cs_simps intro: cat_cs_intros)

qed

lemma (in category) cat_af_Yoneda_arrow_is_ntcf':
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔑 :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    and "β = α"
    and "𝔉' = 𝔉"
    and "𝔊' = 𝔊"
  shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉' ↦CF 𝔊' : 𝔅 ↦↦C⇘β⇙ ℭ"
  using assms(1-3) unfolding assms(4-6) by (rule cat_af_Yoneda_arrow_is_ntcf)

lemmas [cat_cs_intros] = category.cat_af_Yoneda_arrow_is_ntcf'


subsubsection‹Yoneda Lemma for arbitrary functors›


text‹
The following lemmas correspond to variants of the elements of Lemma 3 
in subsection 1.15 in cite‹"bodo_categories_1970"›.
›

lemma (in category) cat_af_Yoneda_map_af_Yoneda_arrow_app:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" 
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔑 :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "𝔑 = HomA.C⇘α⇙(af_Yoneda_arrow α 𝔉 𝔊 𝔑-,-)"
proof-

  let ?H𝔊 = ‹HomO.C⇘α⇙ℭ(𝔊-,-)›
    and ?H𝔉 = ‹HomO.C⇘α⇙ℭ(𝔉-,-)›
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›

  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))

  interpret 𝔑: is_ntcf α ‹op_cat 𝔅 ×C ℭ› ‹cat_Set α› ‹?H𝔊› ‹?H𝔉› 𝔑
    by (rule assms(3))
  interpret aY𝔑: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ‹?aYa 𝔑›
    by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms])
  interpret HY𝔑: is_ntcf 
    α ‹op_cat 𝔅 ×C ℭ› ‹cat_Set α› ‹?H𝔊› ‹?H𝔉› ‹HomA.C⇘α⇙(?aYa 𝔑-,-)›
    by (rule cat_ntcf_lcomp_Hom_is_ntcf[OF aY𝔑.is_ntcf_axioms])
  
  show [cat_cs_simps]: "𝔑 = HomA.C⇘α⇙(?aYa 𝔑-,-)"
  proof 
    (
      rule sym,
      rule ntcf_eqI[OF HY𝔑.is_ntcf_axioms assms(3)], 
      rule vsv_eqI;
      (intro HY𝔑.NTMap.vsv_axioms 𝔑.NTMap.vsv_axioms)?;
      (unfold 𝔑.ntcf_NTMap_vdomain HY𝔑.ntcf_NTMap_vdomain)?
    )
    fix bc assume prems': "bc ∈∘ (op_cat 𝔅 ×C ℭ)⦇Obj⦈"
    then obtain b c
      where bc_def: "bc = [b, c]∘" 
        and op_b: "b ∈∘ op_cat 𝔅⦇Obj⦈" 
        and c: "c ∈∘ ℭ⦇Obj⦈"
      by (auto intro: cat_prod_2_ObjE cat_cs_intros)
    from op_b have b: "b ∈∘ 𝔅⦇Obj⦈" unfolding cat_op_simps by simp

    then have 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈" and 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈"
      by (auto intro: cat_cs_intros)
    have Ym_𝔑:
      "Yoneda_map α HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) (𝔊⦇ObjMap⦈⦇b⦈)⦇
        𝔑⇘op_cat 𝔅,ℭ⇙(b,-)NTCF
        ⦈ = ?aYa 𝔑⦇NTMap⦈⦇b⦈"
      unfolding af_Yoneda_arrow_NTMap_app[OF assms(1) b] by simp
    
    from 
      bnt_proj_snd_is_ntcf
        [
          OF 𝔉.HomDom.category_op category_axioms assms(3) op_b,
          unfolded 
            cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(1) b]
            cat_cf_lcomp_Hom_cf_Hom_snd[OF assms(2) b]
        ]
    have 𝔑b: "𝔑⇘op_cat 𝔅,ℭ⇙(b,-)NTCF :
      HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
      ℭ ↦↦C⇘α⇙ cat_Set α"
      by simp
    from c show "HomA.C⇘α⇙(?aYa 𝔑-,-)⦇NTMap⦈⦇bc⦈ = 𝔑⦇NTMap⦈⦇bc⦈"
      unfolding 
        bc_def 
        cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app[OF aY𝔑.is_ntcf_axioms b c]
        cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(2)[
          OF 𝔊b 𝔉b 𝔑b, unfolded Ym_𝔑, symmetric
          ]
      by (cs_concl cs_shallow cs_simp: cat_cs_simps)

  qed simp_all

qed

lemma (in category) cat_af_Yoneda_Lemma:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "v11 (af_Yoneda_map α 𝔉 𝔊)"
    and "ℛ∘ (af_Yoneda_map α 𝔉 𝔊) =
    these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) HomO.C⇘α⇙ℭ(𝔊-,-) HomO.C⇘α⇙ℭ(𝔉-,-)"
    and "(af_Yoneda_map α 𝔉 𝔊)¯∘ =
      (
        λ𝔑∈∘these_ntcfs
          α (op_cat 𝔅 ×C ℭ) (cat_Set α) HomO.C⇘α⇙ℭ(𝔊-,-) HomO.C⇘α⇙ℭ(𝔉-,-).
          af_Yoneda_arrow α 𝔉 𝔊 𝔑
      )"
proof-

  let ?H𝔊 = ‹HomO.C⇘α⇙ℭ(𝔊-,-)›
    and ?H𝔉 = ‹HomO.C⇘α⇙ℭ(𝔉-,-)›
    and ?aYm = ‹af_Yoneda_map α 𝔉 𝔊›
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›

  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))

  show v11_aY: "v11 ?aYm"
  proof
    (
      intro vsv.vsv_valeq_v11I,
      unfold af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
    )
    
    show "vsv (af_Yoneda_map α 𝔉 𝔊)" by (rule af_Yoneda_map_vsv[OF assms])

    fix φ ψ assume prems:
      "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
      "ψ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ" 
      "?aYm⦇φ⦈ = ?aYm⦇ψ⦈"

    interpret φ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule prems(1))
    interpret ψ: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ψ by (rule prems(2))

    from prems(3) have Hφ_Hψ: "HomA.C⇘α⇙(φ-,-) = HomA.C⇘α⇙(ψ-,-)"
      unfolding 
        af_Yoneda_map_app[OF assms prems(1)]
        af_Yoneda_map_app[OF assms prems(2)]
      by simp

    show "φ = ψ"
    proof
      (
        rule ntcf_eqI[OF prems(1,2)], 
        rule vsv_eqI, 
        unfold φ.ntcf_NTMap_vdomain ψ.ntcf_NTMap_vdomain
      )
      fix b assume prems': "b ∈∘ 𝔅⦇Obj⦈"
      from prems' have φb: "φ⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈" 
        and ψb: "ψ⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈" 
        and 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈" 
        and 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈"
        by (auto intro: cat_cs_intros cat_prod_cs_intros)
      have "HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) = HomA.C⇘α⇙ℭ(ψ⦇NTMap⦈⦇b⦈,-)"
      proof
        (
          rule 
            ntcf_eqI
              [
                OF 
                  cat_ntcf_Hom_snd_is_ntcf[OF φb] 
                  cat_ntcf_Hom_snd_is_ntcf[OF ψb]
              ]
        )
        show "HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈ = HomA.C⇘α⇙ℭ(ψ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈"
        proof
          (
            rule vsv_eqI, 
            unfold 
              ntcf_Hom_snd_NTMap_vdomain[OF φb]
              ntcf_Hom_snd_NTMap_vdomain[OF ψb]
          )
          fix c assume prems'': "c ∈∘ ℭ⦇Obj⦈"
          note H = cat_ntcf_lcomp_Hom_ntcf_Hom_snd_NTMap_app
          show 
            "HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇c⦈ =
              HomA.C⇘α⇙ℭ(ψ⦇NTMap⦈⦇b⦈,-)⦇NTMap⦈⦇c⦈"
            unfolding 
              H[OF prems(1) prems' prems'', symmetric]
              H[OF prems(2) prems' prems'', symmetric]
              Hφ_Hψ
            by simp
        qed 
          (
            simp_all add: 
              ntcf_Hom_snd_NTMap_vsv[OF ψb] ntcf_Hom_snd_NTMap_vsv[OF φb]
          )
      qed simp_all
      with φb ψb show "φ⦇NTMap⦈⦇b⦈ = ψ⦇NTMap⦈⦇b⦈"
        by (auto intro: cat_ntcf_Hom_snd_inj)
    qed auto

  qed

  interpret aYm: v11 ?aYm by (rule v11_aY)

  have [cat_cs_simps]: "?aYm⦇?aYa 𝔑⦈ = 𝔑"
    if "𝔑 : ?H𝔊 ↦CF ?H𝔉 : op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α" for 𝔑
    using category_axioms assms that 
    by 
      (
        cs_concl cs_shallow 
          cs_simp: 
            cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric] cat_cs_simps
          cs_intro: cat_cs_intros
      )

  show aYm_vrange: 
    "ℛ∘ ?aYm = these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) ?H𝔊 ?H𝔉"
  proof(intro vsubset_antisym)
    
    show "ℛ∘ ?aYm ⊆∘ these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) ?H𝔊 ?H𝔉"
    proof
      (
        rule vsv.vsv_vrange_vsubset, 
        unfold these_ntcfs_iff af_Yoneda_map_vdomain[OF assms]
      )
      fix φ assume "φ : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
      with category_axioms assms show 
        "?aYm⦇φ⦈ : ?H𝔊 ↦CF ?H𝔉 : op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
        by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    qed (auto intro: af_Yoneda_map_vsv)

    show "these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) ?H𝔊 ?H𝔉 ⊆∘ ℛ∘ ?aYm"
    proof(rule vsubsetI, unfold these_ntcfs_iff)
      fix 𝔑 assume prems: 
        "𝔑 : ?H𝔊 ↦CF ?H𝔉 : op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
      interpret aY𝔑: is_ntcf α 𝔅 ℭ 𝔉 𝔊 ‹?aYa 𝔑›
        by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
      from prems have 𝔑_def: "𝔑 = ?aYm⦇?aYa 𝔑⦈" 
        by (cs_concl cs_shallow cs_simp: cat_cs_simps)
      from assms aY𝔑.is_ntcf_axioms have "?aYa 𝔑 ∈∘ 𝒟∘ ?aYm"
        by (cs_concl cs_shallow cs_simp: these_ntcfs_iff cat_cs_simps)
      then show "𝔑 ∈∘ ℛ∘ ?aYm" by (subst 𝔑_def, intro aYm.vsv_vimageI2) auto
    qed

  qed

  show "?aYm¯∘ =
    (λ𝔑∈∘these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) ?H𝔊 ?H𝔉. ?aYa 𝔑)"
  proof
    (
      rule vsv_eqI, 
      unfold vdomain_vconverse vdomain_VLambda aYm_vrange these_ntcfs_iff
    )
    from aYm.v11_axioms show "vsv ((af_Yoneda_map α 𝔉 𝔊)¯∘)" by auto
    fix 𝔑 assume prems: "𝔑 : ?H𝔊 ↦CF ?H𝔉 : op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    then have 𝔑: "𝔑 ∈∘ these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) ?H𝔊 ?H𝔉" 
      by simp
    show "?aYm¯∘⦇𝔑⦈ =
      (λ𝔑∈∘these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) ?H𝔊 ?H𝔉. ?aYa 𝔑)⦇𝔑⦈"
    proof
      (
        intro aYm.v11_vconverse_app, 
        unfold beta[OF 𝔑] af_Yoneda_map_vdomain[OF assms] these_ntcfs_iff
      )
      from prems show 𝔑_def: "?aYm⦇?aYa 𝔑⦈ = 𝔑" 
        by (cs_concl cs_shallow cs_simp: cat_cs_simps)
      show "?aYa 𝔑 : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
        by (rule cat_af_Yoneda_arrow_is_ntcf[OF assms prems])
    qed
  qed simp_all

qed


subsubsection‹Inverse of the Yoneda map for arbitrary functors›

lemma (in category) inv_af_Yoneda_map_v11: 
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "v11 ((af_Yoneda_map α 𝔉 𝔊)¯∘)"
  using cat_af_Yoneda_Lemma(1)[OF assms] by (simp add: v11.v11_vconverse)

lemma (in category) inv_af_Yoneda_map_vdomain: 
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "𝒟∘ ((af_Yoneda_map α 𝔉 𝔊)¯∘) =
    these_ntcfs α (op_cat 𝔅 ×C ℭ) (cat_Set α) HomO.C⇘α⇙ℭ(𝔊-,-) HomO.C⇘α⇙ℭ(𝔉-,-)"
  unfolding cat_af_Yoneda_Lemma(3)[OF assms] by simp

lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_vdomain

lemma (in category) inv_af_Yoneda_map_app: 
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔑 :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF  HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "(af_Yoneda_map α 𝔉 𝔊)¯∘⦇𝔑⦈ = af_Yoneda_arrow α 𝔉 𝔊 𝔑"
  using assms(3) unfolding cat_af_Yoneda_Lemma(3)[OF assms(1,2)] by simp

lemmas [cat_cs_simps] = category.inv_af_Yoneda_map_app

lemma (in category) inv_af_Yoneda_map_vrange: 
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "ℛ∘ ((af_Yoneda_map α 𝔉 𝔊)¯∘) = these_ntcfs α 𝔅 ℭ 𝔉 𝔊"
proof-
  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
  from assms show ?thesis 
    unfolding af_Yoneda_map_def by (simp add: cat_cs_simps)
qed


subsubsection‹Yoneda map for arbitrary functors and natural isomorphisms›


text‹
The following lemmas correspond to variants of the elements of
Lemma 3 in subsection 1.15 in cite‹"bodo_categories_1970"›.
›

lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf:
  assumes "φ : 𝔉 ↦CF.iso 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "HomA.C⇘α⇙(φ-,-) :
    HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉-,-) :
    op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
proof-
  interpret φ: is_iso_ntcf α 𝔅 ℭ 𝔉 𝔊 φ by (rule assms(1))
  show ?thesis
  proof(intro cat_ntcf_lcomp_Hom_if_ntcf_Hom_snd_is_iso_ntcf)
    fix b assume "b ∈∘ 𝔅⦇Obj⦈"
    then show "HomA.C⇘α⇙ℭ(φ⦇NTMap⦈⦇b⦈,-) :
      HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
      ℭ ↦↦C⇘α⇙ cat_Set α"
      by 
        (
          auto intro!: 
            cat_is_iso_arr_ntcf_Hom_snd_is_iso_ntcf cat_arrow_cs_intros
        )
  qed (auto simp: cat_cs_intros)
qed

lemma (in category) cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf':
  assumes "φ : 𝔉 ↦CF.iso 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "β = α"
    and "𝔊' = HomO.C⇘α⇙ℭ(𝔊-,-)"
    and "𝔉' = HomO.C⇘α⇙ℭ(𝔉-,-)"
    and "𝔅' = op_cat 𝔅 ×C ℭ"
    and "ℭ' = cat_Set α"
  shows "HomA.C⇘α⇙(φ-,-) : 𝔊' ↦CF.iso 𝔉' : 𝔅' ↦↦C⇘β⇙ ℭ'"
  using assms(1)
  unfolding assms(2-6) 
  by (rule cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf)

lemmas [cat_cs_intros] = 
  category.cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf'

lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔑 :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
  shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉 ↦CF.iso 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
proof-
  
  let ?aYa = ‹af_Yoneda_arrow α 𝔉 𝔊 𝔑›
  
  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
  interpret 𝔑: is_iso_ntcf 
    α ‹op_cat 𝔅 ×C ℭ› ‹cat_Set α› ‹HomO.C⇘α⇙ℭ(𝔊-,-)› ‹HomO.C⇘α⇙ℭ(𝔉-,-)› 𝔑
    by (rule assms(3))

  from assms(1,2) 𝔑.is_ntcf_axioms have 𝔑_def: "𝔑 = HomA.C⇘α⇙(?aYa-,-)" 
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_af_Yoneda_map_af_Yoneda_arrow_app[symmetric]
      )

  from category_axioms assms have aYa: "?aYa : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  have Hom_aYa: "HomA.C⇘α⇙(?aYa-,-) :
    HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉-,-) :
    op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    by (auto intro: assms(3) simp add: 𝔑_def[symmetric])
  have Hb:
    "HomA.C⇘α⇙ℭ(?aYa⦇NTMap⦈⦇b⦈,-) :
      HomO.C⇘α⇙ℭ(𝔊⦇ObjMap⦈⦇b⦈,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉⦇ObjMap⦈⦇b⦈,-) :
      ℭ ↦↦C⇘α⇙ cat_Set α"
    if "b ∈∘ 𝔅⦇Obj⦈" for b
    by 
      ( 
        rule cat_ntcf_Hom_snd_if_ntcf_lcomp_Hom_is_iso_ntcf[
          OF aYa Hom_aYa that
          ]
      )

  show ?thesis
  proof(intro is_iso_ntcfI)
    from category_axioms assms show 
      "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉 ↦CF 𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
      by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
    fix b assume prems: "b ∈∘ 𝔅⦇Obj⦈"
    then have 𝔊b: "𝔊⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈" and 𝔉b: "𝔉⦇ObjMap⦈⦇b⦈ ∈∘ ℭ⦇Obj⦈"
      by (auto intro: cat_cs_intros)
    from assms(1,2) aYa prems have aYa_b: 
      "?aYa⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
      by (cs_concl cs_shallow cs_intro: cat_cs_intros cs_simp: cat_cs_simps)
    show "af_Yoneda_arrow α 𝔉 𝔊 𝔑⦇NTMap⦈⦇b⦈ : 𝔉⦇ObjMap⦈⦇b⦈ ↦iso⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇b⦈"
      by 
        (
          rule cat_is_iso_arr_if_ntcf_Hom_snd_is_iso_ntcf[
            OF aYa_b Hb[OF prems]
            ]
        )
  qed

qed

lemma (in category) cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf':
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔑 :
      HomO.C⇘α⇙ℭ(𝔊-,-) ↦CF.iso HomO.C⇘α⇙ℭ(𝔉-,-) :
      op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    and "β = α"
    and "𝔉' = 𝔉"
    and "𝔊' = 𝔊"
  shows "af_Yoneda_arrow α 𝔉 𝔊 𝔑 : 𝔉' ↦CF.iso 𝔊' : 𝔅 ↦↦C⇘α⇙ ℭ"
  using assms(1-3) 
  unfolding assms(4-6) 
  by (rule cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf)

lemmas [cat_cs_intros] = 
  category.cat_aYa_is_iso_ntcf_if_ntcf_lcomp_Hom_is_iso_ntcf'

lemma (in category) cat_iso_functor_if_cf_lcomp_Hom_iso_functor:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ" 
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "HomO.C⇘α⇙ℭ(𝔉-,-) ≈CF⇘α⇙ HomO.C⇘α⇙ℭ(𝔊-,-)"
  shows "𝔉 ≈CF⇘α⇙ 𝔊"
proof-
  let ?H𝔊 = ‹HomO.C⇘α⇙ℭ(𝔊-,-)›
    and ?H𝔉 = ‹HomO.C⇘α⇙ℭ(𝔉-,-)›
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›
  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
  from assms(3) obtain 𝔑 𝔄 𝔇 where 𝔑: "𝔑 : ?H𝔉 ↦CF.iso ?H𝔊 : 𝔄 ↦↦C⇘α⇙ 𝔇"
    by auto
  interpret 𝔑: is_iso_ntcf α 𝔄 𝔇 ?H𝔉 ?H𝔊 𝔑 by (rule 𝔑)
  from category_axioms assms have "?H𝔉 : op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have 𝔄_def: "𝔄 = op_cat 𝔅 ×C ℭ" and 𝔇_def: "𝔇 = cat_Set α"
    by (force simp: cat_cs_simps)+
  note 𝔑 = 𝔑[unfolded 𝔄_def 𝔇_def]
  from 𝔑 have "𝔑 : ?H𝔉 ↦CF ?H𝔊 : op_cat 𝔅 ×C ℭ ↦↦C⇘α⇙ cat_Set α"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros ntcf_cs_intros
      )
  from category_axioms assms 𝔑 have 
    "af_Yoneda_arrow α 𝔊 𝔉 𝔑 : 𝔊 ↦CF.iso 𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  then have "𝔊 ≈CF⇘α⇙ 𝔉" by (clarsimp intro!: iso_functorI)
  then show ?thesis by (rule iso_functor_sym)
qed

lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor:
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔉 ≈CF⇘α⇙ 𝔊"
  shows "HomO.C⇘α⇙ℭ(𝔉-,-) ≈CF⇘α⇙ HomO.C⇘α⇙ℭ(𝔊-,-)"
proof-
  let ?H𝔊 = ‹HomO.C⇘α⇙ℭ(𝔊-,-)›
    and ?H𝔉 = ‹HomO.C⇘α⇙ℭ(𝔉-,-)›
    and ?aYa = ‹λ𝔑. af_Yoneda_arrow α 𝔉 𝔊 𝔑›
  interpret 𝔉: is_functor α 𝔅 ℭ 𝔉 by (rule assms(1))
  interpret 𝔊: is_functor α 𝔅 ℭ 𝔊 by (rule assms(2))
  from assms obtain 𝔅' ℭ' φ where φ: "φ : 𝔉 ↦CF.iso 𝔊 : 𝔅' ↦↦C⇘α⇙ ℭ'"
    by auto
  interpret φ: is_iso_ntcf α 𝔅' ℭ' 𝔉 𝔊 φ by (rule φ)
  from assms φ.NTDom.is_functor_axioms 
  have 𝔅'_def: "𝔅' = 𝔅" and ℭ'_def: "ℭ' = ℭ" 
    by fast+
  note φ = φ[unfolded 𝔅'_def ℭ'_def]
  show ?thesis
    by (rule iso_functor_sym) 
      (
        intro iso_functorI[
          OF cat_ntcf_lcomp_Hom_is_iso_ntcf_if_is_iso_ntcf[OF φ]
          ]
      )
qed

lemma (in category) cat_cf_lcomp_Hom_iso_functor_if_iso_functor':
  assumes "𝔉 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔊 : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "𝔉 ≈CF⇘α⇙ 𝔊"
    and "α' = α"
    and "ℭ' = ℭ"
  shows "HomO.C⇘α⇙ℭ(𝔉-,-) ≈CF⇘α⇙ HomO.C⇘α'⇙ℭ'(𝔊-,-)"
  using assms(1-3) 
  unfolding assms(4,5) 
  by (rule cat_cf_lcomp_Hom_iso_functor_if_iso_functor)

lemmas [cat_cs_intros] = 
  category.cat_cf_lcomp_Hom_iso_functor_if_iso_functor'



subsection‹The Yoneda Functor›


subsubsection‹Definition and elementary properties›


text‹See Chapter III-2 in cite‹"mac_lane_categories_2010"›.›


definition Yoneda_functor :: "V ⇒ V ⇒ V"
  where "Yoneda_functor α 𝔇 =
    [
      (λr∈∘op_cat 𝔇⦇Obj⦈. cf_map (HomO.C⇘α⇙𝔇(r,-))),
      (λf∈∘op_cat 𝔇⦇Arr⦈. ntcf_arrow (HomA.C⇘α⇙𝔇(f,-))),
      op_cat 𝔇,
      cat_FUNCT α 𝔇 (cat_Set α)
    ]∘"


text‹Components.›

lemma Yoneda_functor_components: 
  shows "Yoneda_functor α 𝔇⦇ObjMap⦈ =
      (λr∈∘op_cat 𝔇⦇Obj⦈. cf_map (HomO.C⇘α⇙𝔇(r,-)))"
    and "Yoneda_functor α 𝔇⦇ArrMap⦈ =
      (λf∈∘op_cat 𝔇⦇Arr⦈. ntcf_arrow (HomA.C⇘α⇙𝔇(f,-)))"
    and "Yoneda_functor α 𝔇⦇HomDom⦈ = op_cat 𝔇"
    and "Yoneda_functor α 𝔇⦇HomCod⦈ = cat_FUNCT α 𝔇 (cat_Set α)"
  unfolding Yoneda_functor_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsection‹Object map›

mk_VLambda Yoneda_functor_components(1)
  |vsv Yoneda_functor_ObjMap_vsv[cat_cs_intros]|
  |vdomain Yoneda_functor_ObjMap_vdomain[cat_cs_simps]|
  |app Yoneda_functor_ObjMap_app[cat_cs_simps]|

lemma (in category) Yoneda_functor_ObjMap_vrange:
  "ℛ∘ (Yoneda_functor α ℭ⦇ObjMap⦈) ⊆∘ cat_FUNCT α ℭ (cat_Set α)⦇Obj⦈"
proof
  (
    unfold Yoneda_functor_components, 
    rule vrange_VLambda_vsubset, 
    unfold cat_op_simps
  )
  fix c assume "c ∈∘ ℭ⦇Obj⦈"
  with category_axioms show 
    "cf_map HomO.C⇘α⇙ℭ(c,-) ∈∘ cat_FUNCT α ℭ (cat_Set α)⦇Obj⦈" 
    unfolding cat_op_simps cat_FUNCT_components
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed


subsubsection‹Arrow map›

mk_VLambda Yoneda_functor_components(2)
  |vsv Yoneda_functor_ArrMap_vsv[cat_cs_intros]|
  |vdomain Yoneda_functor_ArrMap_vdomain[cat_cs_simps]|
  |app Yoneda_functor_ArrMap_app[cat_cs_simps]|

lemma (in category) Yoneda_functor_ArrMap_vrange:
  "ℛ∘ (Yoneda_functor α ℭ⦇ArrMap⦈) ⊆∘ cat_FUNCT α ℭ (cat_Set α)⦇Arr⦈"
proof
  (
    unfold Yoneda_functor_components, 
    rule vrange_VLambda_vsubset, 
    unfold cat_op_simps
  )
  fix f assume "f ∈∘ ℭ⦇Arr⦈"
  then obtain a b where f: "f : a ↦⇘ℭ⇙ b" by auto
  define β where "β = α + ω"
  have 𝒵β: "𝒵 β" and αβ: "α ∈∘ β"
    by (simp_all add: 𝒵_α_αω 𝒵.intro 𝒵_Limit_αω 𝒵_ω_αω β_def)
  from tiny_category_cat_FUNCT category_axioms 𝒵β αβ f show
    "ntcf_arrow HomA.C⇘α⇙ℭ(f,-) ∈∘ cat_FUNCT α ℭ (cat_Set α)⦇Arr⦈" 
    unfolding cat_op_simps
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_FUNCT_cs_intros)
qed


subsubsection‹The Yoneda Functor is a fully faithful functor›

lemma (in category) cat_Yoneda_functor_is_functor:
  assumes "𝒵 β" and "α ∈∘ β"
  shows "Yoneda_functor α ℭ : op_cat ℭ ↦↦C.ff⇘β⇙ cat_FUNCT α ℭ (cat_Set α)"
proof
  (
    intro 
      is_ff_functorI 
      is_ft_functorI' 
      is_fl_functorI' 
      vsubset_antisym 
      vsubsetI,
    unfold cat_op_simps in_Hom_iff, 
    tactic‹distinct_subgoals_tac›
  )

  interpret Set: category α ‹cat_Set α› by (rule category_cat_Set)

  let ?Yf = ‹Yoneda_functor α ℭ› and ?FUNCT = ‹cat_FUNCT α ℭ (cat_Set α)›

  show Yf: "?Yf : op_cat ℭ ↦↦C⇘β⇙ ?FUNCT"
  proof(intro is_functorI')
    show "vfsequence ?Yf" unfolding Yoneda_functor_def by simp
    from assms have "category β ℭ" by (intro cat_category_if_ge_Limit)
    then show "category β (op_cat ℭ)" by (intro category.category_op)
    from assms show "category β ?FUNCT" 
      by 
        (
          cs_concl cs_shallow 
            cs_intro: cat_small_cs_intros tiny_category_cat_FUNCT
        )
    show "vcard ?Yf = 4ℕ"
      unfolding Yoneda_functor_def by (simp add: nat_omega_simps)
    show "ℛ∘ (?Yf⦇ObjMap⦈) ⊆∘ ?FUNCT⦇Obj⦈" 
      by (rule Yoneda_functor_ObjMap_vrange)
    show 
      "?Yf⦇ArrMap⦈⦇f⦈ : ?Yf⦇ObjMap⦈⦇a⦈ ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ?Yf⦇ObjMap⦈⦇b⦈"
      if "f : a ↦⇘op_cat ℭ⇙ b" for a b f
      using that category_axioms
      unfolding cat_op_simps
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show "?Yf⦇ArrMap⦈⦇g ∘A⇘op_cat ℭ⇙ f⦈ = 
      ?Yf⦇ArrMap⦈⦇g⦈ ∘A⇘?FUNCT⇙ ?Yf⦇ArrMap⦈⦇f⦈"
      if "g : b ↦⇘op_cat ℭ⇙ c" and "f : a ↦⇘op_cat ℭ⇙ b" for b c g a f
      using that category_axioms
      unfolding cat_op_simps
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
    show "?Yf⦇ArrMap⦈⦇op_cat ℭ⦇CId⦈⦇c⦈⦈ = ?FUNCT⦇CId⦈⦇?Yf⦇ObjMap⦈⦇c⦈⦈"
      if "c ∈∘ op_cat ℭ⦇Obj⦈" for c 
      using that category_axioms
      unfolding cat_op_simps
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_op_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_FUNCT_cs_intros
        )
  qed (auto simp: assms(1) Yoneda_functor_components 𝒵.intro 𝒵_Limit_αω 𝒵_ω_αω)

  interpret Yf: is_functor β ‹op_cat ℭ› ‹?FUNCT› ‹?Yf› by (rule Yf)

  show "v11 (?Yf⦇ArrMap⦈ ↾l∘ Hom ℭ b a)"
    if "a ∈∘ ℭ⦇Obj⦈" and "b ∈∘ ℭ⦇Obj⦈" for a b
  proof-
    from that have dom_Y_ba: "𝒟∘ (?Yf⦇ArrMap⦈ ↾l∘ Hom ℭ b a) = Hom ℭ b a"
      by 
        (
          fastforce simp: 
            cat_op_simps 
            in_Hom_iff vdomain_vlrestriction Yoneda_functor_components
        )

    show "v11 (?Yf⦇ArrMap⦈ ↾l∘ Hom ℭ b a)"
    proof(intro vsv.vsv_valeq_v11I, unfold dom_Y_ba in_Hom_iff)
      fix g f assume prems:
        "g : b ↦⇘ℭ⇙ a" 
        "f : b ↦⇘ℭ⇙ a" 
        "(?Yf⦇ArrMap⦈ ↾l∘ Hom ℭ b a)⦇g⦈ = (?Yf⦇ArrMap⦈ ↾l∘ Hom ℭ b a)⦇f⦈"
      from 
        prems(3) category_axioms prems(1,2) Yoneda_functor_ArrMap_vsv[of α ℭ] 
      have "HomA.C⇘α⇙ℭ(g,-) = HomA.C⇘α⇙ℭ(f,-)"
        by 
          (
            cs_prems cs_shallow
              cs_simp: V_cs_simps cat_cs_simps cat_op_simps cat_FUNCT_cs_simps
              cs_intro: cat_cs_intros
          )
      from this prems(1,2) show "g = f" by (rule cat_ntcf_Hom_snd_inj)
    qed (auto simp: Yoneda_functor_components)
  qed

  fix a b assume prems: "a ∈∘ ℭ⦇Obj⦈" "b ∈∘ ℭ⦇Obj⦈"
  show "𝔑 : ?Yf⦇ObjMap⦈⦇a⦈ ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ?Yf⦇ObjMap⦈⦇b⦈"
    if "𝔑 ∈∘ ?Yf⦇ArrMap⦈ `∘ Hom ℭ b a" for 𝔑
  proof-
    from that obtain f where "?Yf⦇ArrMap⦈⦇f⦈ = 𝔑" and f: "f : b ↦⇘ℭ⇙ a"
      by (force elim!: Yf.ArrMap.vsv_vimageE)
    then have 𝔑_def: "𝔑 = ntcf_arrow HomA.C⇘α⇙ℭ(f,-)"
      unfolding 
        Yoneda_functor_ArrMap_app[
          unfolded cat_op_simps, OF cat_is_arrD(1)[OF f]
          ]
      by (simp add: cat_cs_simps cat_op_simps cat_cs_intros)
    from category_axioms f show ?thesis
      unfolding 𝔑_def
      by 
        (
          cs_concl  
            cs_simp: cat_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
        )
  qed
  show "𝔑 ∈∘ ?Yf⦇ArrMap⦈ `∘ Hom ℭ b a"
    if "𝔑 : ?Yf⦇ObjMap⦈⦇a⦈ ↦⇘cat_FUNCT α ℭ (cat_Set α)⇙ ?Yf⦇ObjMap⦈⦇b⦈" for 𝔑
  proof-
    note 𝔑 = cat_FUNCT_is_arrD[OF that]
    from 𝔑(1) category_axioms prems have ntcf_𝔑:
      "ntcf_of_ntcf_arrow ℭ (cat_Set α) 𝔑 : 
        HomO.C⇘α⇙ℭ(a,-) ↦CF HomO.C⇘α⇙ℭ(b,-) : ℭ ↦↦C⇘α⇙ cat_Set α"
      by (subst (asm) 𝔑(3), use nothing in ‹subst (asm) 𝔑(4)›)
        (
          cs_prems cs_shallow 
            cs_simp: cat_cs_simps cat_FUNCT_cs_simps 
            cs_intro: cat_cs_intros cat_op_intros cat_FUNCT_cs_intros
        )
    from cat_ntcf_Hom_snd_is_ntcf_Hom_snd_unique(1,2)[OF prems ntcf_𝔑] obtain f 
      where f: "f : b ↦⇘ℭ⇙ a" 
        and 𝔑_def: "ntcf_of_ntcf_arrow ℭ (cat_Set α) 𝔑 = HomA.C⇘α⇙ℭ(f,-)"
      by auto
    from 𝔑(2) f show "𝔑 ∈∘ Yoneda_functor α ℭ⦇ArrMap⦈ `∘ Hom ℭ b a"
      unfolding 𝔑_def
      by (intro Yf.ArrMap.vsv_vimage_eqI[of f]) 
        (
          cs_concl cs_shallow 
            cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_op_intros
        )+
  qed
qed

text‹\newpage›

end