Theory CZH_ECAT_Comma

(* Copyright 2021 (C) Mihails Milehins *)

section‹Comma categories›
theory CZH_ECAT_Comma
  imports 
    CZH_ECAT_NTCF
    CZH_ECAT_Simple
begin



subsection‹Background›

named_theorems cat_comma_cs_simps
named_theorems cat_comma_cs_intros



subsection‹Comma category›


subsubsection‹Definition and elementary properties›


text‹
See Exercise 1.3.vi in cite"riehl_category_2016" or 
Chapter II-6 in cite"mac_lane_categories_2010".
›

definition cat_comma_Obj :: "V  V  V"
  where "cat_comma_Obj 𝔊   set
    {
      [a, b, f] | a b f.
        a  𝔊HomDomObj 
        b  HomDomObj 
        f : 𝔊ObjMapa 𝔊HomCodObjMapb
    }"

lemma small_cat_comma_Obj[simp]: 
  "small
    {
      [a, b, f] | a b f.
        a  𝔄Obj  b  𝔅Obj  f : 𝔊ObjMapa ObjMapb
    }"
  (is small ?abfs)
proof-
  define Q where
    "Q i = (if i = 0 then 𝔄Obj else if i = 1 then 𝔅Obj else Arr)" 
    for i
  have "?abfs  elts (i set {0, 1, 2}. Q i)"
    unfolding Q_def
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, 
      elim exE conjE, 
      intro vproductI; 
      simp only:
    )
    fix a b f show "𝒟 [a, b, f] = set {0, 1, 2}"
      by (simp add: three nat_omega_simps)
  qed (force simp: nat_omega_simps)+
  then show "small ?abfs" by (rule down)
qed

definition cat_comma_Hom :: "V  V  V  V  V"
  where "cat_comma_Hom 𝔊  A B  set
    {
      [A, B, [g, h]] | g h.
        A  cat_comma_Obj 𝔊  
        B  cat_comma_Obj 𝔊  
        g : A0 𝔊HomDomB0 
        h : A1 HomDomB1 
        B2 A𝔊HomCod𝔊ArrMapg =
         ArrMaph A𝔊HomCodA2
    }"

lemma small_cat_comma_Hom[simp]: "small
  {
    [A, B, [g, h]] | g h.
      A  cat_comma_Obj 𝔊  
      B  cat_comma_Obj 𝔊  
      g : A0 𝔄B0 
      h : A1 𝔅B1 
      B2 A𝔊ArrMapg = ArrMaph AA2
  }"
  (is small ?abf_a'b'f'_gh)
proof-
  define Q where
    "Q i =
      (
        if i = 0
        then cat_comma_Obj 𝔊  
        else if i = 1 then cat_comma_Obj 𝔊  else 𝔄Arr × 𝔅Arr
      )"
    for i
  have "?abf_a'b'f'_gh  elts (i set {0, 1, 2}. Q i)"
    unfolding Q_def
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, 
      elim exE conjE,
      intro vproductI; 
      simp only:
    )
    fix a b f show "𝒟 [a, b, f] = ZFC_in_HOL.set {0, 1, 2}"
      by (simp add: three nat_omega_simps)
  qed (force simp : nat_omega_simps)+
  then show "small ?abf_a'b'f'_gh" by (rule down)
qed

definition cat_comma_Arr :: "V  V  V"
  where "cat_comma_Arr 𝔊  
    (
      Acat_comma_Obj 𝔊 . Bcat_comma_Obj 𝔊 .
        cat_comma_Hom 𝔊  A B
    )"

definition cat_comma_composable :: "V  V  V"
  where "cat_comma_composable 𝔊   set
    {
      [[B, C, G], [A, B, F]] | A B C G F.
        [B, C, G]  cat_comma_Arr 𝔊   [A, B, F]  cat_comma_Arr 𝔊 
    }"

lemma small_cat_comma_composable[simp]:
  shows "small
    {
      [[B, C, G], [A, B, F]] | A B C G F.
        [B, C, G]  cat_comma_Arr 𝔊   [A, B, F]  cat_comma_Arr 𝔊 
    }"
  (is small ?S)
proof(rule down)
  show "?S  elts (cat_comma_Arr 𝔊  × cat_comma_Arr 𝔊 )" by auto
qed

definition cat_comma :: "V  V  V" ((_ CFCF _) [1000, 1000] 999)
  where "𝔊 CFCF  =
    [
      cat_comma_Obj 𝔊 ,
      cat_comma_Arr 𝔊 ,
      (λFcat_comma_Arr 𝔊 . F0),
      (λFcat_comma_Arr 𝔊 . F1),
      (
        λGFcat_comma_composable 𝔊 .
          [
            GF10,
            GF01,
            [
              GF020 A𝔊HomDomGF120,
              GF021 AHomDomGF121
            ]
          ]
      ),
      (
        λAcat_comma_Obj 𝔊 .
          [A, A, [𝔊HomDomCIdA0, HomDomCIdA1]]
      )
    ]"


text‹Components.›

lemma cat_comma_components:
  shows "𝔊 CFCF Obj = cat_comma_Obj 𝔊 "
    and "𝔊 CFCF Arr = cat_comma_Arr 𝔊 "
    and "𝔊 CFCF Dom = (λFcat_comma_Arr 𝔊 . F0)"
    and "𝔊 CFCF Cod = (λFcat_comma_Arr 𝔊 . F1)"
    and "𝔊 CFCF Comp =
      (
        λGFcat_comma_composable 𝔊 .
          [
            GF10,
            GF01,
            [
              GF020 A𝔊HomDomGF120,
              GF021 AHomDomGF121
            ]
          ]
      )"
    and "𝔊 CFCF CId =
      (
        λAcat_comma_Obj 𝔊 .
          [A, A, [𝔊HomDomCIdA0, HomDomCIdA1]]
      )"
  unfolding cat_comma_def dg_field_simps by (simp_all add: nat_omega_simps)

context
  fixes α 𝔄 𝔅  𝔊 
  assumes 𝔊: "𝔊 : 𝔄 ↦↦Cα"
    and : " : 𝔅 ↦↦Cα"
begin

interpretation 𝔊: is_functor α 𝔄  𝔊 by (rule 𝔊)
interpretation: is_functor α 𝔅   by (rule )

lemma cat_comma_Obj_def':
  "cat_comma_Obj 𝔊   set
    {
      [a, b, f] | a b f.
        a  𝔄Obj  b  𝔅Obj  f : 𝔊ObjMapa ObjMapb
    }"
  unfolding cat_comma_Obj_def cat_cs_simps by simp

lemma cat_comma_Hom_def':
  "cat_comma_Hom 𝔊  A B  set
    {
      [A, B, [g, h]] | g h.
        A  cat_comma_Obj 𝔊  
        B  cat_comma_Obj 𝔊  
        g : A0 𝔄B0 
        h : A1 𝔅B1 
        B2 A𝔊ArrMapg = ArrMaph AA2
    }"
  unfolding cat_comma_Hom_def cat_cs_simps by simp

lemma cat_comma_components':
  shows "𝔊 CFCF Obj = cat_comma_Obj 𝔊 "
    and "𝔊 CFCF Arr = cat_comma_Arr 𝔊 "
    and "𝔊 CFCF Dom = (λFcat_comma_Arr 𝔊 . F0)"
    and "𝔊 CFCF Cod = (λFcat_comma_Arr 𝔊 . F1)"
    and "𝔊 CFCF Comp =
      (
        λGFcat_comma_composable 𝔊 .
          [
            GF10,
            GF01,
            [
              GF020 A𝔄GF120,
              GF021 A𝔅GF121
            ]
          ]
      )"
    and "𝔊 CFCF CId =
      (λAcat_comma_Obj 𝔊 . [A, A, [𝔄CIdA0, 𝔅CIdA1]])"
  unfolding cat_comma_components cat_cs_simps by simp_all

end


subsubsection‹Objects›

lemma cat_comma_ObjI[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "A = [a, b, f]"
    and "a  𝔄Obj" 
    and "b  𝔅Obj" 
    and "f : 𝔊ObjMapa ObjMapb"
  shows "A  𝔊 CFCF Obj"
  using assms(4-6) 
  unfolding cat_comma_Obj_def'[OF assms(1,2)] assms(3) cat_comma_components 
  by simp

lemma cat_comma_ObjD[dest]:
  assumes "[a, b, f]  𝔊 CFCF Obj"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  shows "a  𝔄Obj" 
    and "b  𝔅Obj" 
    and "f : 𝔊ObjMapa ObjMapb"
  using assms
  unfolding 
    cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)] 
  by auto

lemma cat_comma_ObjE[elim]:
  assumes "A  𝔊 CFCF Obj"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  obtains a b f where "A = [a, b, f]"
    and "a  𝔄Obj" 
    and "b  𝔅Obj" 
    and "f : 𝔊ObjMapa ObjMapb"
  using assms
  unfolding 
    cat_comma_components'[OF assms(2,3)] cat_comma_Obj_def'[OF assms(2,3)] 
  by auto


subsubsection‹Arrows›

lemma cat_comma_HomI[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "F = [A, B, [g, h]]"
    and "A = [a, b, f]"
    and "B = [a', b', f']"
    and "g : a 𝔄a'"
    and "h : b 𝔅b'"
    and "f : 𝔊ObjMapa ObjMapb"
    and "f' : 𝔊ObjMapa' ObjMapb'"
    and "f' A𝔊ArrMapg = ArrMaph Af"
  shows "F  cat_comma_Hom 𝔊  A B"
  using assms(1,2,6-10)
  unfolding cat_comma_Hom_def'[OF assms(1,2)] assms(3-5)
  by 
    (
      intro in_set_CollectI exI conjI small_cat_comma_Hom, 
      unfold cat_comma_components'(1,2)[OF assms(1,2), symmetric],
      (
        cs_concl 
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )+
    )
    (clarsimp simp: nat_omega_simps)+

lemma cat_comma_HomE[elim]:
  assumes "F  cat_comma_Hom 𝔊  A B"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  obtains a b f a' b' f' g h
    where "F = [A, B, [g, h]]"
      and "A = [a, b, f]"
      and "B = [a', b', f']"
      and "g : a 𝔄a'"
      and "h : b 𝔅b'"
      and "f : 𝔊ObjMapa ObjMapb"
      and "f' : 𝔊ObjMapa' ObjMapb'"
      and "f' A𝔊ArrMapg = ArrMaph Af"
  using assms(1) 
  by 
    (
      unfold
        cat_comma_components'[OF assms(2,3)] cat_comma_Hom_def'[OF assms(2,3)],
      elim in_small_setE; 
      (unfold mem_Collect_eq, elim exE conjE cat_comma_ObjE[OF _ assms(2,3)])?,
      insert that,
      all(unfold cat_comma_components'(1,2)[OF assms(2,3), symmetric],
        elim cat_comma_ObjE[OF _ assms(2,3)]) | -
    )
    (auto simp: nat_omega_simps)

lemma cat_comma_HomD[dest]:
  assumes "[[a, b, f], [a', b', f'], [g, h]]  cat_comma_Hom 𝔊  A B"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  shows "g : a 𝔄a'"
    and "h : b 𝔅b'"
    and "f : 𝔊ObjMapa ObjMapb"
    and "f' : 𝔊ObjMapa' ObjMapb'"
    and "f' A𝔊ArrMapg = ArrMaph Af"
  using assms(1) by (force elim!: cat_comma_HomE[OF _ assms(2,3)])+

lemma cat_comma_ArrI[cat_comma_cs_intros]: 
  assumes "F  cat_comma_Hom 𝔊  A B"
    and "A  𝔊 CFCF Obj"
    and "B  𝔊 CFCF Obj"
  shows "F  𝔊 CFCF Arr"
  using assms 
  unfolding cat_comma_components cat_comma_Arr_def 
  by (intro vifunionI)

lemma cat_comma_ArrE[elim]:
  assumes "F  𝔊 CFCF Arr"
  obtains A B 
    where "F  cat_comma_Hom 𝔊  A B"
      and "A  𝔊 CFCF Obj"
      and "B  𝔊 CFCF Obj"
  using assms unfolding cat_comma_components cat_comma_Arr_def by auto

lemma cat_comma_ArrD[dest]: 
  assumes "[A, B, F]  𝔊 CFCF Arr"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  shows "[A, B, F]  cat_comma_Hom 𝔊  A B"
    and "A  𝔊 CFCF Obj"
    and "B  𝔊 CFCF Obj"
proof-
  from assms obtain C D 
    where "[A, B, F]  cat_comma_Hom 𝔊  C D"
      and "C  𝔊 CFCF Obj"
      and "D  𝔊 CFCF Obj"
    by (elim cat_comma_ArrE)
  moreover from cat_comma_HomE[OF this(1) assms(2,3)] have "A = C" and "B = D"
    by auto
  ultimately show "[A, B, F]  cat_comma_Hom 𝔊  A B"
    and "A  𝔊 CFCF Obj"
    and "B  𝔊 CFCF Obj"
    by auto
qed


subsubsection‹Domain›

lemma cat_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (𝔊 CFCF Dom)"
  unfolding cat_comma_components by simp

lemma cat_comma_Dom_vdomain[cat_comma_cs_simps]:
  "𝒟 (𝔊 CFCF Dom) = 𝔊 CFCF Arr"
  unfolding cat_comma_components by simp

lemma cat_comma_Dom_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]" and "ABF  𝔊 CFCF Arr"
  shows "𝔊 CFCF DomABF = A"
  using assms(2) unfolding assms(1) cat_comma_components by simp

lemma cat_comma_Dom_vrange:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (𝔊 CFCF Dom)  𝔊 CFCF Obj"
proof(rule vsv.vsv_vrange_vsubset)
  fix ABF assume "ABF  𝒟 (𝔊 CFCF Dom)"
  then have "ABF  𝔊 CFCF Arr" 
    by (cs_prems cs_shallow cs_simp: cat_comma_cs_simps)
  then obtain A B 
    where ABF: "ABF  cat_comma_Hom 𝔊  A B"
      and A: "A  𝔊 CFCF Obj"
      and B: "B  𝔊 CFCF Obj"
    by auto
  from this(1) obtain a b f a' b' f' g h
    where "ABF = [A, B, [g, h]]"
      and "A = [a, b, f]"
      and "B = [a', b', f']"
      and "g : a 𝔄a'"
      and "h : b 𝔅b'"
      and "f : 𝔊ObjMapa ObjMapb"
      and "f' : 𝔊ObjMapa' ObjMapb'"
      and "f' A𝔊ArrMapg = ArrMaph Af"
    by (elim cat_comma_HomE[OF _ assms(1,2)])
  from ABF this A B show "𝔊 CFCF DomABF  𝔊 CFCF Obj"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
      )
qed (auto intro: cat_comma_cs_intros)


subsubsection‹Codomain›

lemma cat_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (𝔊 CFCF Cod)"
  unfolding cat_comma_components by simp

lemma cat_comma_Cod_vdomain[cat_comma_cs_simps]:
  "𝒟 (𝔊 CFCF Cod) = 𝔊 CFCF Arr"
  unfolding cat_comma_components by simp

lemma cat_comma_Cod_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]" and "ABF  𝔊 CFCF Arr"
  shows "𝔊 CFCF CodABF = B"
  using assms(2)
  unfolding assms(1) cat_comma_components
  by (simp add: nat_omega_simps)

lemma cat_comma_Cod_vrange:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (𝔊 CFCF Cod)  𝔊 CFCF Obj"
proof(rule vsv.vsv_vrange_vsubset)
  fix ABF assume "ABF  𝒟 (𝔊 CFCF Cod)"
  then have "ABF  𝔊 CFCF Arr" 
    by (cs_prems cs_shallow cs_simp: cat_comma_cs_simps)
  then obtain A B 
    where F: "ABF  cat_comma_Hom 𝔊  A B"
      and A: "A  𝔊 CFCF Obj"
      and B: "B  𝔊 CFCF Obj"
    by auto
  from this(1) obtain a b f a' b' f' g h
    where "ABF = [A, B, [g, h]]"
      and "A = [a, b, f]"
      and "B = [a', b', f']"
      and "g : a 𝔄a'"
      and "h : b 𝔅b'"
      and "f : 𝔊ObjMapa ObjMapb"
      and "f' : 𝔊ObjMapa' ObjMapb'"
      and "f' A𝔊ArrMapg = ArrMaph Af"
    by (elim cat_comma_HomE[OF _ assms(1,2)])
  from F this A B show "𝔊 CFCF CodABF  𝔊 CFCF Obj"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
      )
qed (auto intro: cat_comma_cs_intros)


subsubsection‹Arrow with a domain and a codomain›

lemma cat_comma_is_arrI[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "ABF = [A, B, F]"
    and "A = [a, b, f]"
    and "B = [a', b', f']"
    and "F = [g, h]"
    and "g : a 𝔄a'"
    and "h : b 𝔅b'"
    and "f : 𝔊ObjMapa ObjMapb"
    and "f' : 𝔊ObjMapa' ObjMapb'"
    and "f' A𝔊ArrMapg = ArrMaph Af"
  shows "ABF : A 𝔊 CFCF B"
proof(intro is_arrI)
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  from assms(7-11) show "ABF  𝔊 CFCF Arr"
    unfolding assms(3-6)
    by 
      (
        cs_concl  
          cs_simp: cat_comma_cs_simps 
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  with assms(7-11) show "𝔊 CFCF DomABF = A" "𝔊 CFCF CodABF = B"
    unfolding assms(3-6) by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)+
qed

lemma cat_comma_is_arrD[dest]:
  assumes "[[a, b, f], [a', b', f'], [g, h]] :
    [a, b, f] 𝔊 CFCF [a', b', f']"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  shows "g : a 𝔄a'"
    and "h : b 𝔅b'"
    and "f : 𝔊ObjMapa ObjMapb"
    and "f' : 𝔊ObjMapa' ObjMapb'"
    and "f' A𝔊ArrMapg = ArrMaph Af"
proof-
  note F_is_arrD = is_arrD[OF assms(1)]
  note F_cat_comma_ArrD = cat_comma_ArrD[OF F_is_arrD(1) assms(2,3)]
  show "g : a 𝔄a'"
    and "h : b 𝔅b'"
    and "f : 𝔊ObjMapa ObjMapb"
    and "f' : 𝔊ObjMapa' ObjMapb'"
    and "f' A𝔊ArrMapg = ArrMaph Af"
    by (intro cat_comma_HomD[OF F_cat_comma_ArrD(1) assms(2,3)])+    
qed

lemma cat_comma_is_arrE[elim]:
  assumes "ABF : A 𝔊 CFCF B"
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  obtains a b f a' b' f' g h
    where "ABF = [[a, b, f], [a', b', f'], [g, h]]"
      and "A = [a, b, f]"
      and "B = [a', b', f']"
      and "g : a 𝔄a'"
      and "h : b 𝔅b'"
      and "f : 𝔊ObjMapa ObjMapb"
      and "f' : 𝔊ObjMapa' ObjMapb'"
      and "f' A𝔊ArrMapg = ArrMaph Af"
proof-
  note F_is_arrD = is_arrD[OF assms(1)]
  from F_is_arrD(1) obtain C D 
    where "ABF  cat_comma_Hom 𝔊  C D"
      and "C  𝔊 CFCF Obj" 
      and "D  𝔊 CFCF Obj"
    by auto
  from this(1) obtain a b f a' b' f' g h
    where F_def: "ABF = [C, D, [g, h]]"
      and "C = [a, b, f]"
      and "D = [a', b', f']"
      and "g : a 𝔄a'"
      and "h : b 𝔅b'"
      and "f : 𝔊ObjMapa ObjMapb"
      and "f' : 𝔊ObjMapa' ObjMapb'"
      and "f' A𝔊ArrMapg = ArrMaph Af"
     by (elim cat_comma_HomE[OF _ assms(2,3)])
  with that show ?thesis 
    by (metis F_is_arrD(1,2,3) cat_comma_Cod_app cat_comma_Dom_app)
qed


subsubsection‹Composition›

lemma cat_comma_composableI:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "ABCGF = [BCG, ABF]"
    and "BCG : B 𝔊 CFCF C"
    and "ABF : A 𝔊 CFCF B"
  shows "ABCGF  cat_comma_composable 𝔊 "
proof-
  from assms(1,2,5) obtain a b f a' b' f' gh 
    where ABF_def: "ABF = [[a, b, f], [a', b', f'], gh]"
      and "A = [a, b, f]"
      and  "B = [a', b', f']"
    by auto
  with assms(1,2,4) obtain a'' b'' f'' g'h' 
    where BCG_def: "BCG = [[a', b', f'], [a'', b'', f''], g'h']"
      and "B = [a', b', f']"
      and "C = [a'', b'', f'']"
    by auto
  from is_arrD(1)[OF assms(4)] have "BCG  cat_comma_Arr 𝔊 "
    unfolding cat_comma_components'(2)[OF assms(1,2)].
  moreover from is_arrD(1)[OF assms(5)] have "ABF  cat_comma_Arr 𝔊 "
    unfolding cat_comma_components'(2)[OF assms(1,2)].
  ultimately show ?thesis 
    unfolding assms(3) ABF_def BCG_def cat_comma_composable_def 
    by simp
qed

lemma cat_comma_composableE[elim]:
  assumes "ABCGF  cat_comma_composable 𝔊 "
    and "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
  obtains BCG ABF A B C
    where "ABCGF = [BCG, ABF]"
      and "BCG : B 𝔊 CFCF C"
      and "ABF : A 𝔊 CFCF B"
proof-
  from assms(1) obtain A B C G F 
    where ABCGF_def: "ABCGF = [[B, C, G], [A, B, F]]"
      and BCG: "[B, C, G]  𝔊 CFCF Arr"
      and ABF: "[A, B, F]  𝔊 CFCF Arr"
    unfolding cat_comma_composable_def
    by (auto simp: cat_comma_components'[OF assms(2,3)])  
  note BCG = cat_comma_ArrD[OF BCG assms(2,3)]
    and ABF = cat_comma_ArrD[OF ABF assms(2,3)]
  from ABF(1) assms(2,3) obtain a b f a' b' f' g h
    where "[A, B, F] = [A, B, [g, h]]"
      and A_def: "A = [a, b, f]"
      and B_def: "B = [a', b', f']"
      and F_def: "F = [g, h]"
      and g: "g : a 𝔄a'"
      and h: "h : b 𝔅b'"
      and f: "f : 𝔊ObjMapa ObjMapb"
      and f': "f' : 𝔊ObjMapa' ObjMapb'"
      and [cat_comma_cs_simps]: 
        "f' A𝔊ArrMapg = ArrMaph Af"
    by auto
  with BCG(1) assms(2,3) obtain a'' b'' f'' g' h'
    where g'h'_def: "[B, C, G] = [B, C, [g', h']]"
      and C_def: "C = [a'', b'', f'']"
      and G_def: "G = [g', h']"
      and g': "g' : a' 𝔄a''"
      and h': "h' : b' 𝔅b''"
      and f'': "f'' : 𝔊ObjMapa'' ObjMapb''"
      and [cat_comma_cs_simps]: 
        "f'' A𝔊ArrMapg' = ArrMaph' Af'"
    by auto  
  from F_def have "F = [g, h]" by simp
  from assms(2,3) g h f f' g' h' f'' have 
    "[B, C, G] : B 𝔊 CFCF C"
    unfolding ABCGF_def F_def G_def A_def B_def C_def
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI
      )+
  moreover from assms(2,3) g h f f' g' h' f'' have 
    "[A, B, F] : A 𝔊 CFCF B"
    unfolding ABCGF_def F_def G_def A_def B_def C_def
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_is_arrI
      )+
  ultimately show ?thesis using that ABCGF_def by auto
qed

lemma cat_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (𝔊 CFCF Comp)"
  unfolding cat_comma_components by auto

lemma cat_comma_Comp_vdomain[cat_comma_cs_simps]: 
  "𝒟 (𝔊 CFCF Comp) = cat_comma_composable 𝔊 "
  unfolding cat_comma_components by auto

lemma cat_comma_Comp_app[cat_comma_cs_simps]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "G = [B, C, [g', h']]"
    and "F = [A, B, [g, h]]"
    and "G : B 𝔊 CFCF C" 
    and "F : A 𝔊 CFCF B"
  shows "G A𝔊 CFCF F = [A, C, [g' A𝔄g, h' A𝔅h]]"
  using assms(1,2,5,6)
  unfolding cat_comma_components'[OF assms(1,2)] assms(3,4)
  by (*slow*)
    (
      cs_concl 
        cs_simp: omega_of_set V_cs_simps vfsequence_simps
        cs_intro: nat_omega_intros V_cs_intros cat_comma_composableI TrueI
    )

lemma cat_comma_Comp_is_arr[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "BCG : B 𝔊 CFCF C" 
    and "ABF : A 𝔊 CFCF B"
  shows "BCG A𝔊 CFCF ABF : A 𝔊 CFCF C"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  from assms(1,2,4) obtain a b f a' b' f' g h
    where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
      and A_def: "A = [a, b, f]"
      and B_def: "B = [a', b', f']"
      and g: "g : a 𝔄a'"
      and h: "h : b 𝔅b'"
      and f: "f : 𝔊ObjMapa ObjMapb"
      and f': "f' : 𝔊ObjMapa' ObjMapb'"
      and [symmetric, cat_cs_simps]: 
        "f' A𝔊ArrMapg = ArrMaph Af"
    by auto
  with assms(1,2,3) obtain a'' b'' f'' g' h'
    where BCG_def: "BCG = [[a', b', f'], [a'', b'', f''], [g', h']]"
      and C_def: "C = [a'', b'', f'']"
      and g': "g' : a' 𝔄a''"
      and h': "h' : b' 𝔅b''"
      and f'': "f'' : 𝔊ObjMapa'' ObjMapb''"
      and [cat_cs_simps]: "f'' A𝔊ArrMapg' = ArrMaph' Af'"
    by auto (*slow*)
  from g' have 𝔊g': "𝔊ArrMapg' : 𝔊ObjMapa' 𝔊ObjMapa''"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  note [cat_cs_simps] = 
    category.cat_assoc_helper[
      where= and h=f'' and g=𝔊ArrMapg' and q=ArrMaph' Af'
      ]
    category.cat_assoc_helper[
      where= and h=f and g=ArrMaph and q=f' A𝔊ArrMapg
      ]
  from assms(1,2,3,4) g h f f' g' h' f'' show ?thesis
    unfolding ABF_def BCG_def A_def B_def C_def
    by (intro cat_comma_is_arrI[OF assms(1,2)])
      (
        cs_concl cs_shallow
          cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
      )+
qed


subsubsection‹Identity›

lemma cat_comma_CId_vsv[cat_comma_cs_intros]: "vsv (𝔊 CFCF CId)"
  unfolding cat_comma_components by simp

lemma cat_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "𝒟 (𝔊 CFCF CId) = 𝔊 CFCF Obj"
  unfolding cat_comma_components'[OF assms(1,2)] by simp

lemma cat_comma_CId_app[cat_comma_cs_simps]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "A = [a, b ,f]"
    and "A  𝔊 CFCF Obj"
  shows "𝔊 CFCF CIdA = [A, A, [𝔄CIda, 𝔅CIdb]]"
proof-
  from assms(4)[unfolded assms(3), unfolded cat_comma_components'[OF assms(1,2)]]
  have "[a, b, f]  cat_comma_Obj 𝔊 ".
  then show ?thesis
    unfolding cat_comma_components'(6)[OF assms(1,2)] assms(3)
    by (simp add: nat_omega_simps)
qed


subsubsectionHom›-set›

lemma cat_comma_Hom:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "A  𝔊 CFCF Obj"
    and "B  𝔊 CFCF Obj"
  shows "Hom (𝔊 CFCF ) A B = cat_comma_Hom 𝔊  A B"
proof(intro vsubset_antisym vsubsetI, unfold in_Hom_iff)
  fix ABF assume "ABF : A 𝔊 CFCF B"
  with assms(1,2) show "ABF  cat_comma_Hom 𝔊  A B"
    by (elim cat_comma_is_arrE[OF _ assms(1,2)], intro cat_comma_HomI) force+
next
  fix ABF assume "ABF  cat_comma_Hom 𝔊  A B"
  with assms(1,2) show "ABF : A 𝔊 CFCF B"
    by (elim cat_comma_HomE[OF _ assms(1,2)], intro cat_comma_is_arrI) force+
qed


subsubsection‹Comma category is a category›

lemma category_cat_comma[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "category α (𝔊 CFCF )"
proof-

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

  show ?thesis
  proof(rule categoryI')

    show "vfsequence (𝔊 CFCF )" unfolding cat_comma_def by auto
    show "vcard (𝔊 CFCF ) = 6"
      unfolding cat_comma_def by (simp add: nat_omega_simps)
    show " (𝔊 CFCF Dom)  𝔊 CFCF Obj"
      by (rule cat_comma_Dom_vrange[OF assms])
    show " (𝔊 CFCF Cod)  𝔊 CFCF Obj"
      by (rule cat_comma_Cod_vrange[OF assms])
    show "(GF  𝒟 (𝔊 CFCF Comp)) 
      (g f b c a. GF = [g, f]  g : b 𝔊 CFCF c  f : a 𝔊 CFCF b)"
      for GF
    proof(intro iffI; (elim exE conjE)?; (simp only: cat_comma_Comp_vdomain)?)
      assume prems: "GF  cat_comma_composable 𝔊 "
      with assms obtain G F abf a'b'f' a''b''f'' 
        where "GF = [G, F]"
          and "G : a'b'f' 𝔊 CFCF a''b''f''"
          and "F : abf 𝔊 CFCF a'b'f'"
        by auto
      with assms show "g f b c a.
        GF = [g, f]  g : b 𝔊 CFCF c  f : a 𝔊 CFCF b"
        by auto
    qed (use assms in cs_concl cs_shallow cs_intro: cat_comma_composableI)
    from assms show "𝒟 (𝔊 CFCF CId) = 𝔊 CFCF Obj"
      by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
    from assms show "G A𝔊 CFCF F : A 𝔊 CFCF C"
      if "G : B 𝔊 CFCF C" and "F : A 𝔊 CFCF B"
      for B C G A F
      using that by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
    from assms show 
      "H A𝔊 CFCF G A𝔊 CFCF F =
        H A𝔊 CFCF (G A𝔊 CFCF F)"
      if "H : C 𝔊 CFCF D"
        and "G : B 𝔊 CFCF C"
        and "F : A 𝔊 CFCF B"
      for C D H B G A F
      using assms that
    proof-
      from that(3) assms obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and f: "f : 𝔊ObjMapa ObjMapb"
          and f': "f' : 𝔊ObjMapa' ObjMapb'"
          and [cat_cs_simps]: "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      with that(2) assms obtain a'' b'' f'' g' h'
        where G_def: "G = [[a', b', f'], [a'', b'', f''], [g', h']]"
          and C_def: "C = [a'', b'', f'']"
          and g': "g' : a' 𝔄a''"
          and h': "h' : b' 𝔅b''"
          and f'': "f'' : 𝔊ObjMapa'' ObjMapb''"
          and [cat_cs_simps]: 
            "f'' A𝔊ArrMapg' = ArrMaph' Af'"
        by auto (*slow*)
      with that(1) assms obtain a''' b''' f''' g'' h''
        where H_def: "H = [[a'', b'', f''], [a''', b''', f'''], [g'', h'']]"
          and D_def: "D = [a''', b''', f''']"
          and g'': "g'' : a'' 𝔄a'''"
          and h'': "h'' : b'' 𝔅b'''"
          and f''': "f''' : 𝔊ObjMapa''' ObjMapb'''"
          and [cat_cs_simps]: 
            "f''' A𝔊ArrMapg'' = ArrMaph'' Af''"
        by auto (*slow*)      
      note [cat_cs_simps] =
        category.cat_assoc_helper[
          where=
            and h=f''
            and g=𝔊ArrMapg'
            and q=ArrMaph' Af'
          ]
        category.cat_assoc_helper[
          where=
            and h=f''
            and g=𝔊ArrMapg'
            and q=ArrMaph' Af'
          ]
        category.cat_assoc_helper[
          where= 
            and h=f''' 
            and g=𝔊ArrMapg'' 
            and q=ArrMaph'' Af''
          ]
      from assms that g h f f' g' h' f'' g'' h''  f''' show ?thesis
        unfolding F_def G_def H_def A_def B_def C_def D_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )
    qed

    show "𝔊 CFCF CIdA : A 𝔊 CFCF A"
      if "A  𝔊 CFCF Obj" for A
      using that
      by (elim cat_comma_ObjE[OF _ assms(1)]; (simp only:)?) 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+

    show "𝔊 CFCF CIdB A𝔊 CFCF F = F"
      if "F : A 𝔊 CFCF B" for A B F
      using that 
      by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+

    show "F A𝔊 CFCF 𝔊 CFCF CIdB = F"
      if "F : B 𝔊 CFCF C" for B C F
      using that 
      by (elim cat_comma_is_arrE[OF _ assms]; (simp only:)?)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+

    show "𝔊 CFCF Obj  Vset α"
    proof(intro vsubsetI, elim cat_comma_ObjE[OF _ assms])
      fix F a b f assume prems: 
        "F = [a, b, f]" 
        "a  𝔄Obj" 
        "b  𝔅Obj"
        "f : 𝔊ObjMapa ObjMapb"
      from prems(2-4) show "F  Vset α"
        unfolding prems(1) by (cs_concl cs_intro: cat_cs_intros V_cs_intros) 
    qed

    show "(aA. bB. Hom (𝔊 CFCF ) a b)  Vset α"
      if "A  𝔊 CFCF Obj"
        and "B  𝔊 CFCF Obj"
        and "A  Vset α"
        and "B  Vset α"
      for A B
    proof-

      define A0 where "A0 =  (λFA. F0)"
      define A1 where "A1 =  (λFA. F1)"
      define B0 where "B0 =  (λFB. F0)"
      define B1 where "B1 =  (λFB. F1)"

      define A0B0 where "A0B0 = (aA0. bB0. Hom 𝔄 a b)"
      define A1B1 where "A1B1 = (aA1. bB1. Hom 𝔅 a b)"

      have A0B0: "A0B0  Vset α"
        unfolding A0B0_def
      proof(rule 𝔊.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
        show "A0  Vset α"
          unfolding A0_def
        proof(intro vrange_vprojection_in_VsetI that(3))
          fix F assume "F  A"
          with that(1) have "F  𝔊 CFCF Obj" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]" by auto
          show "vsv F" unfolding F_def by auto
          show "0  𝒟 F" unfolding F_def by simp
        qed auto
        show "B0  Vset α"
          unfolding B0_def
        proof(intro vrange_vprojection_in_VsetI that(4))
          fix F assume "F  B"
          with that(2) have "F  𝔊 CFCF Obj" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]" by auto
          show "vsv F" unfolding F_def by auto
          show "0  𝒟 F" unfolding F_def by simp
        qed auto
      next
        fix a assume "a  A0"
        with that(1) obtain F 
          where a_def: "a = F0" and "F  𝔊 CFCF Obj" 
          unfolding A0_def by force
        with assms obtain b f where "F = [a, b, f]" and "a  𝔄Obj" by auto
        then show "a  𝔄Obj" unfolding a_def by simp
      next
        fix a assume "a  B0"
        with that(2) obtain F 
          where a_def: "a = F0" and "F  𝔊 CFCF Obj" 
          unfolding B0_def by force
        with assms obtain b f where "F = [a, b, f]" and "a  𝔄Obj" by auto
        then show "a  𝔄Obj" unfolding a_def by simp
      qed

      have A1B1: "A1B1  Vset α"
        unfolding A1B1_def
      proof(rule 𝔉.HomDom.cat_Hom_vifunion_in_Vset; (intro vsubsetI)?)
        show "A1  Vset α"
          unfolding A1_def
        proof(intro vrange_vprojection_in_VsetI that(3))
          fix F assume "F  A"
          with that(1) have "F  𝔊 CFCF Obj" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]" by auto
          show "vsv F" unfolding F_def by auto
          show "1  𝒟 F" unfolding F_def by (simp add: nat_omega_simps)
        qed auto
        show "B1  Vset α"
          unfolding B1_def
        proof(intro vrange_vprojection_in_VsetI that(4))
          fix F assume "F  B"
          with that(2) have "F  𝔊 CFCF Obj" by auto
          with assms obtain a b f where F_def: "F = [a, b, f]" by auto
          show "vsv F" unfolding F_def by auto
          show "1  𝒟 F" unfolding F_def by (simp add: nat_omega_simps)
        qed auto
      next
        fix b assume "b  A1"
        with that(1) obtain F 
          where b_def: "b = F1" and "F  𝔊 CFCF Obj" 
          unfolding A1_def by force
        with assms obtain a f where "F = [a, b, f]" and "b  𝔅Obj" 
          by (auto simp: nat_omega_simps)
        then show "b  𝔅Obj" unfolding b_def by simp
      next
        fix b assume "b  B1"
        with that(2) obtain F 
          where b_def: "b = F1" and "F  𝔊 CFCF Obj" 
          unfolding B1_def by force
        with assms obtain a f where "F = [a, b, f]" and "b  𝔅Obj" 
          by (auto simp: nat_omega_simps)
        then show "b  𝔅Obj" unfolding b_def by simp
      qed
      
      define Q where 
        "Q i = (if i = 0 then A else if i = 1 then B else (A0B0 × A1B1))" 
        for i
      have 
        "(aA. bB.
          Hom (𝔊 CFCF ) a b)  (i set {0, 1, 2}. Q i)"
      proof
        (
          intro vsubsetI,
          elim vifunionE,
          unfold in_Hom_iff,
          intro vproductI ballI
        )
        fix abf a'b'f' F assume prems: 
          "abf  A" "a'b'f'  B" "F : abf 𝔊 CFCF a'b'f'"
        from prems(3) assms obtain a b f a' b' f' g h
          where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
            and abf_def: "abf = [a, b, f]"
            and a'b'f'_def: "a'b'f' = [a', b', f']"
            and g: "g : a 𝔄a'"
            and h: "h : b 𝔅b'"
            and "f : 𝔊ObjMapa ObjMapb"
            and "f' : 𝔊ObjMapa' ObjMapb'"
            and "f' A𝔊ArrMapg = ArrMaph Af"
          by auto
        have gh: "[g, h]  A0B0 × A1B1"
          unfolding A0B0_def A1B1_def 
        proof
          (
            intro ftimesI2 vifunionI, 
            unfold in_Hom_iff A0_def B0_def A1_def B1_def
          )
          from prems(1) show "a   (λFA. F0)"
            by (intro vsv.vsv_vimageI2'[where a=abf]) (simp_all add: abf_def)
          from prems(2) show "a'   (λFB. F0)"
            by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
              (simp_all add: a'b'f'_def)
          from prems(1) show "b   (λFA. F1)"
            by (intro vsv.vsv_vimageI2'[where a=abf]) 
              (simp_all add: nat_omega_simps abf_def)
          from prems(2) show "b'   (λFB. F1)"
            by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
              (simp_all add: nat_omega_simps a'b'f'_def)
        qed (intro g h)+
        show "vsv F" unfolding F_def by auto
        show "𝒟 F = set {0, 1, 2}"
          by (simp add: F_def three nat_omega_simps)
        fix i assume "i  set {0, 1, 2}"
        then consider i = 0 | i = 1 | i = 2 by auto
        from this prems show "Fi  Q i" 
          by cases
            (simp_all add: F_def Q_def gh abf_def a'b'f'_def nat_omega_simps)
      qed
      moreover have "(i set {0, 1, 2}. Q i)  Vset α"
      proof(rule Limit_vproduct_in_VsetI)
        show "set {0, 1, 2}  Vset α" 
          by (cs_concl cs_shallow cs_intro: V_cs_intros)
        from A0B0 A1B1 assms(1,2) that(3,4) show 
          "Q i  Vset α" if "i  set {0, 1, 2}" 
          for i 
          by (simp_all add: Q_def Limit_ftimes_in_VsetI nat_omega_simps)
      qed auto
      ultimately show "(aA. bB. Hom (𝔊 CFCF ) a b)  Vset α" by auto
    qed
  qed (auto simp: cat_comma_cs_simps intro: cat_comma_cs_intros)

qed


subsubsection‹Tiny comma category›

lemma tiny_category_cat_comma[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦C.tmα" and " : 𝔅 ↦↦C.tmα"
  shows "tiny_category α (𝔊 CFCF )"
proof-

  interpret 𝔊: is_tm_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_tm_functor α 𝔅   by (rule assms(2))
  note 𝔊 = 𝔊.is_functor_axioms 
    and  = ℌ.is_functor_axioms
  interpret category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)

  show ?thesis
  proof(intro tiny_categoryI' category_cat_comma)
    have vrange_𝔊: " (𝔊ObjMap)  Vset α"
      by (simp add: vrange_in_VsetI 𝔊.tm_cf_ObjMap_in_Vset)
    moreover have vrange_ℌ: " (ObjMap)  Vset α"
      by (simp add: vrange_in_VsetI ℌ.tm_cf_ObjMap_in_Vset)
    ultimately have UU_Hom_in_Vset:
      "(a (𝔊ObjMap). b (ObjMap). Hom  a b)  Vset α"
      using 𝔊.cf_ObjMap_vrange ℌ.cf_ObjMap_vrange 
      by (auto intro: 𝔊.HomCod.cat_Hom_vifunion_in_Vset) 
    define Q where
      "Q i =
        (
          if i = 0
          then 𝔄Obj
          else
            if i = 1
            then 𝔅Obj
            else (a (𝔊ObjMap). b (ObjMap). Hom  a b)
        )" 
      for i
    have "𝔊 CFCF Obj  (i set {0, 1, 2}. Q i)"
    proof(intro vsubsetI)
      fix A assume "A  𝔊 CFCF Obj"
      then obtain a b f
        where A_def: "A = [a, b, f]"
          and a: "a  𝔄Obj"
          and b: "b  𝔅Obj"
          and f: "f : 𝔊ObjMapa ObjMapb"
        by (elim cat_comma_ObjE[OF _ 𝔊 ])
      from f have f:
        "f  (a (𝔊ObjMap). b (ObjMap). Hom  a b)"
        by (intro vifunionI, unfold in_Hom_iff)
          (
            simp_all add: 
              a b 
              ℌ.ObjMap.vsv_vimageI2 
              ℌ.cf_ObjMap_vdomain 
              𝔊.ObjMap.vsv_vimageI2 
              𝔊.cf_ObjMap_vdomain
          )
      show "A  (i set {0, 1, 2}. Q i)"
      proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
        show "𝒟 A = set {0, 1, 2}"
          unfolding A_def by (simp add: three nat_omega_simps)
        fix i assume "i  set {0, 1, 2}"
        then consider i = 0 | i = 1 | i = 2 by auto
        from this a b f show "Ai  Q i"
          unfolding A_def Q_def by cases (simp_all add: nat_omega_simps)
      qed (auto simp: A_def)
    qed
    moreover have "(i set {0, 1, 2}. Q i)  Vset α"
    proof(rule Limit_vproduct_in_VsetI)
      show "set {0, 1, 2}  Vset α"
        unfolding three[symmetric] by simp
      from this show "Q i  Vset α" if "i  set {0, 1, 2}" for i
        using that assms(1,2) UU_Hom_in_Vset  
        by 
          (
            simp_all add:
              Q_def 
              𝔊.HomDom.tiny_cat_Obj_in_Vset 
              ℌ.HomDom.tiny_cat_Obj_in_Vset 
              nat_omega_simps
          )
    qed auto
    ultimately show [simp]: "𝔊 CFCF Obj  Vset α" by auto 
    define Q where
      "Q i =
        (
          if i = 0
          then 𝔊 CFCF Obj
          else
            if i = 1
            then 𝔊 CFCF Obj
            else 𝔄Arr × 𝔅Arr
        )" 
    for i
    have "𝔊 CFCF Arr  (i set {0, 1, 2}. Q i)"
    proof(intro vsubsetI)
      fix F assume "F  𝔊 CFCF Arr"
      then obtain abf a'b'f' where F: "F : abf 𝔊 CFCF a'b'f'"
        by (auto intro: is_arrI)
      with assms obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
          and abf_def: "abf = [a, b, f]"
          and a'b'f'_def: "a'b'f' = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and "f : 𝔊ObjMapa ObjMapb"
          and "f' : 𝔊ObjMapa' ObjMapb'"
          and "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      from g h have "[g, h]  𝔄Arr × 𝔅Arr" by auto      
      show "F  (i set {0, 1, 2}. Q i)"
      proof(intro vproductI, unfold Ball_def; (intro allI impI)?)
        show "𝒟 F = set {0, 1, 2}"
          by (simp add: F_def three nat_omega_simps)
        fix i assume "i  set {0, 1, 2}"
        then consider i = 0 | i = 1 | i = 2 by auto
        from this F g h show "Fi  Q i"
          unfolding Q_def F_def abf_def[symmetric] a'b'f'_def[symmetric]
          by cases (auto simp: nat_omega_simps)
      qed (auto simp: F_def)
    qed
    moreover have "(i set {0, 1, 2}. Q i)  Vset α"
    proof(rule Limit_vproduct_in_VsetI)
      show "set {0, 1, 2}  Vset α"
        by (simp add: three[symmetric] nat_omega_simps)
      moreover have "𝔄Arr × 𝔅Arr  Vset α"
        by 
          (
            auto intro!: 
              Limit_ftimes_in_VsetI 
              𝔊.𝒵_β 𝒵_def 
              𝔊.HomDom.tiny_cat_Arr_in_Vset 
              ℌ.HomDom.tiny_cat_Arr_in_Vset
          )
      ultimately show "Q i  Vset α" if "i  set {0, 1, 2}" for i
        using that assms(1,2) UU_Hom_in_Vset  
        by 
          (
            simp_all add:
              Q_def
              𝔊.HomDom.tiny_cat_Obj_in_Vset 
              ℌ.HomDom.tiny_cat_Obj_in_Vset 
              nat_omega_simps
          )
    qed auto
    ultimately show "𝔊 CFCF Arr  Vset α" by auto
  qed (rule 𝔊, rule )

qed



subsection‹Opposite comma category functor›


subsubsection‹Background›


text‹
See cite"noauthor_wikipedia_2001"\footnote{
\url{https://en.wikipedia.org/wiki/Opposite_category}
} for background information.
›


subsubsection‹Object flip›

definition op_cf_commma_obj_flip :: "V  V  V"
  where "op_cf_commma_obj_flip 𝔊  =
    (λA(𝔊 CFCF )Obj. [A1, A0, A2])"


text‹Elementary properties.›

mk_VLambda op_cf_commma_obj_flip_def
  |vsv op_cf_commma_obj_flip_vsv[cat_comma_cs_intros]|
  |vdomain op_cf_commma_obj_flip_vdomain[cat_comma_cs_simps]|
  |app op_cf_commma_obj_flip_app'|

lemma op_cf_commma_obj_flip_app[cat_comma_cs_simps]:
  assumes "A = [a, b, f]" and "A  (𝔊 CFCF )Obj"
  shows "op_cf_commma_obj_flip 𝔊 A = [b, a, f]"
  using assms unfolding op_cf_commma_obj_flip_def by (simp add: nat_omega_simps)

lemma op_cf_commma_obj_flip_v11[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "v11 (op_cf_commma_obj_flip 𝔊 )"
proof(rule vsv.vsv_valeq_v11I, unfold op_cf_commma_obj_flip_vdomain)
  fix A B assume prems:
    "A  𝔊 CFCF Obj"
    "B  𝔊 CFCF Obj"
    "op_cf_commma_obj_flip 𝔊 A = op_cf_commma_obj_flip 𝔊 B"
  from prems(1,2) assms obtain a b f a' b' f' 
    where A_def: "A = [a, b, f]" 
      and B_def: "B = [a', b', f']"
    by (elim cat_comma_ObjE[OF _ assms])
  from prems(3,1,2) show "A = B"
    by (simp_all add: A_def B_def op_cf_commma_obj_flip_app nat_omega_simps)
qed (auto intro: op_cf_commma_obj_flip_vsv)

lemma op_cf_commma_obj_flip_vrange[cat_comma_cs_simps]:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (op_cf_commma_obj_flip 𝔊 ) = (op_cf ) CFCF (op_cf 𝔊)Obj"
proof(intro vsubset_antisym)
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  show " (op_cf_commma_obj_flip 𝔊 )  (op_cf ) CFCF (op_cf 𝔊)Obj"
  proof
    (
      intro vsv.vsv_vrange_vsubset op_cf_commma_obj_flip_vsv, 
      unfold cat_comma_cs_simps
    )
    fix A assume "A  𝔊 CFCF Obj"
    then obtain a b f
      where A_def: "A = [a, b, f]"
        and a: "a  𝔄Obj"
        and b: "b  𝔅Obj"
        and f: "f : 𝔊ObjMapa ObjMapb"
      by (elim cat_comma_ObjE[OF _ assms])
    from a b f show 
      "op_cf_commma_obj_flip 𝔊 A  (op_cf ) CFCF (op_cf 𝔊)Obj"
      unfolding A_def
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_comma_cs_simps cat_op_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
        )
  qed
  show "(op_cf ) CFCF (op_cf 𝔊)Obj   (op_cf_commma_obj_flip 𝔊 )"
  proof(intro vsubsetI)
    fix B assume "B  (op_cf ) CFCF (op_cf 𝔊)Obj"
    then obtain a b f
      where B_def: "B = [b, a, f]"
        and b: "b  𝔅Obj"
        and a: "a  𝔄Obj"
        and f: "f : 𝔊ObjMapa ObjMapb"
      by 
        (
          elim cat_comma_ObjE[
            OF _ ℌ.is_functor_op 𝔊.is_functor_op, unfolded cat_op_simps
            ]
        )
    from a b f have B_def: "B = op_cf_commma_obj_flip 𝔊 a, b, f"
      by 
        (
          cs_concl cs_shallow 
            cs_simp: cat_comma_cs_simps B_def
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    from a b f have "[a, b, f]  𝒟 (op_cf_commma_obj_flip 𝔊 )"
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
    with op_cf_commma_obj_flip_vsv show "B   (op_cf_commma_obj_flip 𝔊 )"
      unfolding B_def by auto
  qed
qed


subsubsection‹Definition and elementary properties›

definition op_cf_comma :: "V  V  V"
  where "op_cf_comma 𝔊  =
    [
      op_cf_commma_obj_flip 𝔊 ,
      (
        λABF(𝔊 CFCF )Arr.
          [
            op_cf_commma_obj_flip 𝔊 ABF1,
            op_cf_commma_obj_flip 𝔊 ABF0,
            [ABF21, ABF20]
          ]
      ),
      op_cat (𝔊 CFCF ),
      (op_cf ) CFCF (op_cf 𝔊)
    ]"


text‹Components.›

lemma op_cf_comma_components:
  shows [cat_comma_cs_simps]: 
      "op_cf_comma 𝔊 ObjMap = op_cf_commma_obj_flip 𝔊 "
    and "op_cf_comma 𝔊 ArrMap =
      (
        λABF(𝔊 CFCF )Arr.
          [
            op_cf_commma_obj_flip 𝔊 ABF1,
            op_cf_commma_obj_flip 𝔊 ABF0,
            [ABF21, ABF20]
          ]
      )"
    and [cat_comma_cs_simps]: 
      "op_cf_comma 𝔊 HomDom = op_cat (𝔊 CFCF )"
    and [cat_comma_cs_simps]: 
      "op_cf_comma 𝔊 HomCod = (op_cf ) CFCF (op_cf 𝔊)"
  unfolding op_cf_comma_def dghm_field_simps by (simp_all add: nat_omega_simps)


subsubsection‹Arrow map›

mk_VLambda op_cf_comma_components(2)
  |vsv op_cf_comma_ArrMap_vsv[cat_comma_cs_intros]|
  |vdomain op_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]|
  |app op_cf_comma_ArrMap_app'|

lemma op_cf_comma_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [[a, b, f], [a', b', f'], [g, h]]"
    and "ABF  𝔊 CFCF Arr"
  shows "op_cf_comma 𝔊 ArrMapABF =
    [
      op_cf_commma_obj_flip 𝔊 a', b', f',
      op_cf_commma_obj_flip 𝔊 a, b, f,
      [h, g]
    ]"
  using assms(2) by (simp add: assms(1) op_cf_comma_ArrMap_app' nat_omega_simps)

lemma op_cf_comma_ArrMap_v11[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "v11 (op_cf_comma 𝔊 ArrMap)"
proof
  (
    rule vsv.vsv_valeq_v11I, 
    unfold op_cf_comma_ArrMap_vdomain,
    intro op_cf_comma_ArrMap_vsv
  )
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔊ℌ: category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  fix ABF ABF' assume prems:
    "ABF  𝔊 CFCF Arr"
    "ABF'  𝔊 CFCF Arr"
    "op_cf_comma 𝔊 ArrMapABF = op_cf_comma 𝔊 ArrMapABF'"
  from prems(1) obtain A B where ABF: "ABF : A 𝔊 CFCF B" by auto
  from prems(2) obtain A' B' where ABF': "ABF' : A' 𝔊 CFCF B'" by auto
  from ABF obtain a b f a' b' f' g h 
    where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
      and A_def: "A = [a, b, f]"
      and B_def: "B = [a', b', f']"
      and "g : a 𝔄a'"
      and "h : b 𝔅b'"
      and "f : 𝔊ObjMapa ObjMapb"
      and "f' : 𝔊ObjMapa' ObjMapb'"
      and "f' A𝔊ArrMapg = ArrMaph Af"
    by (elim cat_comma_is_arrE[OF _ assms])
  from ABF' obtain a'' b'' f'' a''' b''' f''' g' h' 
    where ABF'_def: "ABF' = [[a'', b'', f''], [a''', b''', f'''], [g', h']]"
      and A'_def: "A' = [a'', b'', f'']"
      and B'_def: "B' = [a''', b''', f''']"
      and "g' : a'' 𝔄a'''"
      and "h' : b'' 𝔅b'''"
      and "f'' : 𝔊ObjMapa'' ObjMapb''"
      and "f''' : 𝔊ObjMapa''' ObjMapb'''"
      and "f''' A𝔊ArrMapg' = ArrMaph' Af''"
    by (elim cat_comma_is_arrE[OF _ assms])
  from ABF ABF' have abf:
    "[a, b, f]  (𝔊 CFCF )Obj"
    "[a', b', f']  (𝔊 CFCF )Obj"
    "[a'', b'', f'']  (𝔊 CFCF )Obj"
    "[a''', b''', f''']  (𝔊 CFCF )Obj"
    unfolding ABF_def ABF'_def A_def B_def A'_def B'_def by auto
  note v11_injective = v11.v11_injective[
      OF op_cf_commma_obj_flip_v11, OF assms, unfolded cat_comma_cs_simps
      ]
  from 
    prems(3,1,2) assms 
    op_cf_commma_obj_flip_v11 
    v11_injective[OF abf(1,3)] 
    v11_injective[OF abf(2,4)] 
  show "ABF = ABF'"
    by 
      (
        simp_all add: 
          ABF_def ABF'_def op_cf_comma_ArrMap_app' nat_omega_simps 
      )
qed

lemma op_cf_comma_ArrMap_is_arr:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "ABF : A 𝔊 CFCF B"
  shows "op_cf_comma 𝔊 ArrMapABF :
    op_cf_commma_obj_flip 𝔊 B (op_cf ) CFCF (op_cf 𝔊)op_cf_commma_obj_flip 𝔊 A"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔊ℌ: category α 𝔊 CFCF  
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms(3) obtain a b f a' b' f' g h
    where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
      and A_def: "A = [a, b, f]"
      and B_def: "B = [a', b', f']"
      and g: "g : a 𝔄a'"
      and h: "h : b 𝔅b'"
      and f: "f : 𝔊ObjMapa ObjMapb"
      and f': "f' : 𝔊ObjMapa' ObjMapb'"
      and f'g_hf: "f' A𝔊ArrMapg = ArrMaph Af"
    by (elim cat_comma_is_arrE[OF _ assms(1,2)])
  from g h f f' f'g_hf show ?thesis
    unfolding ABF_def A_def B_def
    by 
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )
qed

lemma op_cf_comma_ArrMap_is_arr':
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "ABF : A 𝔊 CFCF B"
    and "A' = op_cf_commma_obj_flip 𝔊 B"
    and "B' = op_cf_commma_obj_flip 𝔊 A"
  shows "op_cf_comma 𝔊 ArrMapABF : A' (op_cf ) CFCF (op_cf 𝔊)B'"
  using assms(1-3) unfolding assms(4,5) by (intro op_cf_comma_ArrMap_is_arr)

lemma op_cf_comma_ArrMap_vrange[cat_comma_cs_simps]:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (op_cf_comma 𝔊 ArrMap) = (op_cf ) CFCF (op_cf 𝔊)Arr"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔊ℌ: category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  interpret op_𝔊ℌ: category α (op_cf ) CFCF (op_cf 𝔊)
    by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros cat_op_intros)
  show ?thesis
  proof(intro vsubset_antisym)
    show " (op_cf_comma 𝔊 ArrMap)  (op_cf ) CFCF (op_cf 𝔊)Arr"
    proof
      (
        intro vsv.vsv_vrange_vsubset op_cf_comma_ArrMap_vsv, 
        unfold cat_comma_cs_simps
      )
      fix ABF assume prems: "ABF  𝔊 CFCF Arr"
      then obtain A B where ABF: "ABF : A 𝔊 CFCF B" by auto
      from op_cf_comma_ArrMap_is_arr[OF assms this] show 
        "op_cf_comma 𝔊 ArrMapABF  (op_cf ) CFCF (op_cf 𝔊)Arr"
        by auto
    qed
    show "(op_cf ) CFCF (op_cf 𝔊)Arr   (op_cf_comma 𝔊 ArrMap)"
    proof(intro vsubsetI)
      fix ABF assume prems: "ABF  (op_cf ) CFCF (op_cf 𝔊)Arr"
      then obtain A B where ABF: "ABF : A (op_cf ) CFCF (op_cf 𝔊)B" 
        by auto
      then obtain a b f a' b' f' g h
        where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a' 𝔅a"
          and h: "h : b' 𝔄b"
          and f: "f : 𝔊ObjMapb ObjMapa"
          and f': "f' : 𝔊ObjMapb' ObjMapa'" 
          and f'g_hf: "f' Aop_cat ArrMapg = 𝔊ArrMaph Aop_cat f"
        by 
          (
            elim cat_comma_is_arrE[
              OF _ ℌ.is_functor_op 𝔊.is_functor_op, unfolded cat_op_simps
              ]
          )
      from f'g_hf g h f f' have gf'_fh:
        "ArrMapg Af' = f A𝔊ArrMaph"
        by 
          (
            cs_prems cs_shallow 
              cs_simp: cat_op_simps cs_intro: cat_cs_intros cat_op_intros
          )
      with g h f f' have 
        "[[b', a', f'], [b, a, f], [h, g]]  𝒟 (op_cf_comma 𝔊 ArrMap)"
        "ABF = op_cf_comma 𝔊 ArrMap[b', a', f'], [b, a, f], [h, g]"
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_comma_cs_simps ABF_def
              cs_intro: cat_cs_intros cat_comma_cs_intros
          )+
      with op_cf_comma_ArrMap_vsv show "ABF   (op_cf_comma 𝔊 ArrMap)"
        by auto
    qed
  qed
qed


subsubsection‹Opposite comma category functor is an isomorphism of categories›

lemma op_cf_comma_is_iso_functor:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "op_cf_comma 𝔊  : 
    op_cat (𝔊 CFCF ) ↦↦C.isoα(op_cf ) CFCF (op_cf 𝔊)"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  show ?thesis
  proof(intro is_iso_functorI' is_functorI')
    show "vfsequence (op_cf_comma 𝔊 )"
      unfolding op_cf_comma_def by simp
    show "vcard (op_cf_comma 𝔊 ) = 4"
      unfolding op_cf_comma_def by (simp add: nat_omega_simps)
    from assms show "op_cf_comma 𝔊 ArrMapABF :
      op_cf_comma 𝔊 ObjMapA (op_cf ) CFCF (op_cf 𝔊)op_cf_comma 𝔊 ObjMapB"
      if "ABF : A op_cat (𝔊 CFCF )B" for A B ABF
      using that
      unfolding cat_op_simps
      by 
        (
          cs_concl cs_shallow
            cs_intro: op_cf_comma_ArrMap_is_arr' cs_simp: cat_comma_cs_simps
        )
    show
      "op_cf_comma 𝔊 ArrMapG Aop_cat (𝔊 CFCF )F =
        op_cf_comma 𝔊 ArrMapG A(op_cf ) CFCF (op_cf 𝔊)op_cf_comma 𝔊 ArrMapF"
      if "G : B op_cat (𝔊 CFCF )C" 
        and "F : A op_cat (𝔊 CFCF )B"
      for B C G A F
    proof-
      note G = that(1)[unfolded cat_op_simps]
      note F = that(2)[unfolded cat_op_simps]
      from assms G obtain a b f a' b' f' g h
        where G_def: "G = [[a, b, f], [a', b', f'], [g, h]]"
          and C_def: "C = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and f: "f : 𝔊ObjMapa ObjMapb"
          and f': "f' : 𝔊ObjMapa' ObjMapb'"
          and [symmetric, cat_comma_cs_simps]: 
            "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      with assms F obtain a'' b'' f'' g' h'
        where F_def: "F = [[a', b', f'], [a'', b'', f''], [g', h']]"
          and A_def: "A = [a'', b'', f'']"
          and g': "g' : a' 𝔄a''"
          and h': "h' : b' 𝔅b''"
          and f'': "f'' : 𝔊ObjMapa'' ObjMapb''"
          and [cat_comma_cs_simps]: 
            "f'' A𝔊ArrMapg' = ArrMaph' Af'"
        by auto (*slow*)
      note [cat_comma_cs_simps] = 
        category.cat_assoc_helper[
          where= and h=f'' and g=𝔊ArrMapg' and q=ArrMaph' Af'
          ]
      from assms that g h f f' g' h' f' f'' show ?thesis
        unfolding cat_op_simps G_def C_def B_def F_def A_def
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
          )
    qed
    show 
      "op_cf_comma 𝔊 ArrMapop_cat (𝔊 CFCF )CIdC =
        (op_cf ) CFCF (op_cf 𝔊)CIdop_cf_comma 𝔊 ObjMapC"
      if "C  op_cat (𝔊 CFCF )Obj" for C
    proof-
      from that[unfolded cat_op_simps] assms obtain a b f 
        where C_def: "C = [a, b, f]"
          and a: "a  𝔄Obj" 
          and b: "b  𝔅Obj"
          and f: "f : 𝔊ObjMapa ObjMapb"
        by auto
      from a b f that show ?thesis
        unfolding cat_op_simps C_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
          )
    qed
  qed
    (
      cs_concl cs_shallow
        cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
        cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_op_intros
    )+
qed

lemma op_cf_comma_is_iso_functor'[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "𝔄' = op_cat (𝔊 CFCF )"
    and "𝔅' = (op_cf ) CFCF (op_cf 𝔊)"
  shows "op_cf_comma 𝔊  : 𝔄' ↦↦C.isoα𝔅'"
  using assms(1,2) unfolding assms(3,4) by (rule op_cf_comma_is_iso_functor)

lemma op_cf_comma_is_functor:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "op_cf_comma 𝔊  :
    op_cat (𝔊 CFCF ) ↦↦Cα(op_cf ) CFCF (op_cf 𝔊)"
  by (rule is_iso_functorD(1)[OF op_cf_comma_is_iso_functor[OF assms]])

lemma op_cf_comma_is_functor'[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "𝔄' = op_cat (𝔊 CFCF )"
    and "𝔅' = (op_cf ) CFCF (op_cf 𝔊)"
  shows "op_cf_comma 𝔊  : 𝔄' ↦↦Cα𝔅'"
  using assms(1,2) unfolding assms(3,4) by (rule op_cf_comma_is_functor)



subsection‹Projections for a comma category›


subsubsection‹Definitions and elementary properties›


text‹See Chapter II-6 in cite"mac_lane_categories_2010".›

definition cf_comma_proj_left :: "V  V  V" ((_ CF _) [1000, 1000] 999)
  where "𝔊 CF  =
    [
      (λa𝔊 CFCF Obj. a0),
      (λf𝔊 CFCF Arr. f20),
      𝔊 CFCF ,
      𝔊HomDom
    ]"

definition cf_comma_proj_right :: "V  V  V" ((_ CF _) [1000, 1000] 999)
  where "𝔊 CF  =
    [
      (λa𝔊 CFCF Obj. a1),
      (λf𝔊 CFCF Arr. f21),
      𝔊 CFCF ,
      HomDom
    ]"


text‹Components.›

lemma cf_comma_proj_left_components:
  shows "𝔊 CF ObjMap = (λa𝔊 CFCF Obj. a0)"
    and "𝔊 CF ArrMap = (λf𝔊 CFCF Arr. f20)"
    and "𝔊 CF HomDom = 𝔊 CFCF "
    and "𝔊 CF HomCod = 𝔊HomDom"
  unfolding cf_comma_proj_left_def dghm_field_simps
  by (simp_all add: nat_omega_simps)

lemma cf_comma_proj_right_components:
  shows "𝔊 CF ObjMap = (λa𝔊 CFCF Obj. a1)"
    and "𝔊 CF ArrMap = (λf𝔊 CFCF Arr. f21)"
    and "𝔊 CF HomDom = 𝔊 CFCF "
    and "𝔊 CF HomCod = HomDom"
  unfolding cf_comma_proj_right_def dghm_field_simps
  by (simp_all add: nat_omega_simps)

context
  fixes α 𝔄 𝔅  𝔊 
  assumes 𝔊: "𝔊 : 𝔄 ↦↦Cα"
    and : " : 𝔅 ↦↦Cα"
begin

interpretation 𝔊: is_functor α 𝔄  𝔊 by (rule 𝔊)
interpretation: is_functor α 𝔅   by (rule )

lemmas cf_comma_proj_left_components' = 
  cf_comma_proj_left_components[of 𝔊 , unfolded 𝔊.cf_HomDom]

lemmas cf_comma_proj_right_components' = 
  cf_comma_proj_right_components[of 𝔊 , unfolded ℌ.cf_HomDom]

lemmas [cat_comma_cs_simps] = 
  cf_comma_proj_left_components'(3,4)
  cf_comma_proj_right_components'(3,4)

end


subsubsection‹Object map›

mk_VLambda cf_comma_proj_left_components(1)
  |vsv cf_comma_proj_left_ObjMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_left_ObjMap_vdomain[cat_comma_cs_simps]|

mk_VLambda cf_comma_proj_right_components(1)
  |vsv cf_comma_proj_right_ObjMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_right_ObjMap_vdomain[cat_comma_cs_simps]|

lemma cf_comma_proj_left_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, b, f]" and "[a, b, f]  𝔊 CFCF Obj"
  shows "𝔊 CF ObjMapA = a"
  using assms(2) unfolding assms(1) cf_comma_proj_left_components by simp

lemma cf_comma_proj_right_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, b, f]" and "[a, b, f]  𝔊 CFCF Obj"
  shows "𝔊 CF ObjMapA = b"
  using assms(2)
  unfolding assms(1) cf_comma_proj_right_components 
  by (simp add: nat_omega_simps)

lemma cf_comma_proj_left_ObjMap_vrange:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (𝔊 CF ObjMap)  𝔄Obj"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  fix A assume prems: "A  𝔊 CFCF Obj"
  with assms obtain a b f where A_def: "A = [a, b, f]" and a: "a  𝔄Obj"
    by auto
  from assms prems a show "𝔊 CF ObjMapA  𝔄Obj"
    unfolding A_def by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
qed (auto intro: cat_comma_cs_intros)  

lemma cf_comma_proj_right_ObjMap_vrange:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (𝔊 CF ObjMap)  𝔅Obj"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  fix A assume prems: "A  𝔊 CFCF Obj"
  with assms obtain a b f where A_def: "A = [a, b, f]" and b: "b  𝔅Obj"
    by auto
  from assms prems b show "𝔊 CF ObjMapA  𝔅Obj"
    unfolding A_def by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
qed (auto intro: cat_comma_cs_intros)  


subsubsection‹Arrow map›

mk_VLambda cf_comma_proj_left_components(2)
  |vsv cf_comma_proj_left_ArrMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_left_ArrMap_vdomain[cat_comma_cs_simps]|

mk_VLambda cf_comma_proj_right_components(2)
  |vsv cf_comma_proj_right_ArrMap_vsv[cat_comma_cs_intros]|
  |vdomain cf_comma_proj_right_ArrMap_vdomain[cat_comma_cs_simps]|

lemma cf_comma_proj_left_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, [g, h]]" and "[A, B, [g, h]]  𝔊 CFCF Arr"
  shows "𝔊 CF ArrMapABF = g"
  using assms(2)
  unfolding assms(1) cf_comma_proj_left_components 
  by (simp add: nat_omega_simps)

lemma cf_comma_proj_right_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, [g, h]]" 
    and "[A, B, [g, h]]  𝔊 CFCF Arr"
  shows "𝔊 CF ArrMapABF = h"
  using assms(2)
  unfolding assms(1) cf_comma_proj_right_components 
  by (simp add: nat_omega_simps)

lemma cf_comma_proj_left_ArrMap_vrange:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (𝔊 CF ArrMap)  𝔄Arr"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  from assms interpret category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
  fix F assume prems: "F  𝔊 CFCF Arr"
  then obtain A B where "F : A 𝔊 CFCF B" by auto
  with assms obtain a b f a' b' f' g h
    where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
      and g: "g : a 𝔄a'"
    by auto
  from assms prems g show "𝔊 CF ArrMapF  𝔄Arr"
    unfolding F_def 
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_comma_cs_intros)  

lemma cf_comma_proj_right_ArrMap_vrange:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows " (𝔊 CF ArrMap)  𝔅Arr"
proof(rule vsv.vsv_vrange_vsubset, unfold cat_comma_cs_simps)
  from assms interpret category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
  fix F assume prems: "F  𝔊 CFCF Arr"
  then obtain A B where F: "F : A 𝔊 CFCF B" by auto
  with assms obtain a b f a' b' f' g h
    where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
      and h: "h : b 𝔅b'"
    by auto
  from assms prems h show "𝔊 CF ArrMapF  𝔅Arr"
    unfolding F_def 
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
qed (auto intro: cat_comma_cs_intros)  


subsubsection‹Projections for a comma category are functors›

lemma cf_comma_proj_left_is_functor:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "𝔊 CF  : 𝔊 CFCF  ↦↦Cα𝔄"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  from assms interpret 𝔊ℌ: category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (𝔊 CF )"
      unfolding cf_comma_proj_left_def by auto
    show "vcard (𝔊 CF ) = 4"
      unfolding cf_comma_proj_left_def by (simp add: nat_omega_simps)
    from assms show " (𝔊 CF ObjMap)  𝔄Obj"
      by (rule cf_comma_proj_left_ObjMap_vrange)
    show "𝔊 CF ArrMapF : 𝔊 CF ObjMapA 𝔄𝔊 CF ObjMapB"
      if "F : A 𝔊 CFCF B" for A B F
    proof-
      from assms that obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
        by auto
      from that g show 
        "𝔊 CF ArrMapF : 𝔊 CF ObjMapA 𝔄𝔊 CF ObjMapB"
        unfolding F_def A_def B_def
        by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
    qed
    show 
      "𝔊 CF ArrMapG A𝔊 CFCF F =
        𝔊 CF ArrMapG A𝔄𝔊 CF ArrMapF"
      if "G : B 𝔊 CFCF C" and "F : A 𝔊 CFCF B" for B C G A F
    proof-
      from assms that(2) obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and f: "f : 𝔊ObjMapa ObjMapb"
          and f': "f' : 𝔊ObjMapa' ObjMapb'"
          and [cat_cs_simps]: "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      with that(1) assms obtain a'' b'' f'' g' h'
        where G_def: "G = [[a', b', f'], [a'', b'', f''], [g', h']]"
          and C_def: "C = [a'', b'', f'']"
          and g': "g' : a' 𝔄a''"
          and h': "h' : b' 𝔅b''"
          and f'': "f'' : 𝔊ObjMapa'' ObjMapb''"
          and [cat_cs_simps]: "f'' A𝔊ArrMapg' = ArrMaph' Af'"
        by auto (*slow*)
      note [cat_cs_simps] = 
        category.cat_assoc_helper
          [
            where= 
              and h=f'' 
              and g=𝔊ArrMapg' 
              and q=ArrMaph' Af'
          ]
        category.cat_assoc_helper
          [
            where= 
              and h=f 
              and g=ArrMaph 
              and q=f' A𝔊ArrMapg
          ]
      from assms that g g' h h' f f' f'' show ?thesis
        unfolding F_def G_def A_def B_def C_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
    show "𝔊 CF ArrMap𝔊 CFCF CIdA = 𝔄CId𝔊 CF ObjMapA"
      if "A  𝔊 CFCF Obj" for A
    proof-
      from assms that obtain a b f 
        where A_def: "A = [a, b, f]"
          and "a  𝔄Obj" 
          and "b  𝔅Obj" 
          and "f : 𝔊ObjMapa ObjMapb"
        by auto
      from assms that this(2-4) show ?thesis
        unfolding A_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps 
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
  qed 
    (
      use assms in 
        cs_concl cs_shallow
            cs_simp: cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
    )+
qed

lemma cf_comma_proj_left_is_functor'[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "𝔄' = 𝔊 CFCF "
  shows "𝔊 CF  : 𝔄' ↦↦Cα𝔄"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_functor)

lemma cf_comma_proj_right_is_functor:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "𝔊 CF  : 𝔊 CFCF  ↦↦Cα𝔅"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  from assms interpret 𝔊ℌ: category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
  show ?thesis
  proof(rule is_functorI')
    show "vfsequence (𝔊 CF )"
      unfolding cf_comma_proj_right_def by auto
    show "vcard (𝔊 CF ) = 4"
      unfolding cf_comma_proj_right_def by (simp add: nat_omega_simps)
    from assms show " (𝔊 CF ObjMap)  𝔅Obj"
      by (rule cf_comma_proj_right_ObjMap_vrange)
    show "𝔊 CF ArrMapF : 𝔊 CF ObjMapA 𝔅𝔊 CF ObjMapB"
      if "F : A 𝔊 CFCF B" for A B F
    proof-
      from assms that obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and h: "h : b 𝔅b'"
        by auto
      from that h show 
        "𝔊 CF ArrMapF : 𝔊 CF ObjMapA 𝔅𝔊 CF ObjMapB"
        unfolding F_def A_def B_def
        by (cs_concl cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
    qed
    show 
      "𝔊 CF ArrMapG A𝔊 CFCF F =
        𝔊 CF ArrMapG A𝔅𝔊 CF ArrMapF"
      if "G : B 𝔊 CFCF C" and "F : A 𝔊 CFCF B" for B C G A F
    proof-
      from assms that(2) obtain a b f a' b' f' g h
        where F_def: "F = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and f: "f : 𝔊ObjMapa ObjMapb"
          and f': "f' : 𝔊ObjMapa' ObjMapb'"
          and [cat_cs_simps]: "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      with that(1) assms obtain a'' b'' f'' g' h'
        where G_def: "G = [[a', b', f'], [a'', b'', f''], [g', h']]"
          and C_def: "C = [a'', b'', f'']"
          and g': "g' : a' 𝔄a''"
          and h': "h' : b' 𝔅b''"
          and f'': "f'' : 𝔊ObjMapa'' ObjMapb''"
          and [cat_cs_simps]: "f'' A𝔊ArrMapg' = ArrMaph' Af'"
        by auto (*slow*)
      note [cat_cs_simps] = 
        category.cat_assoc_helper
          [
            where= 
              and h=f'' 
              and g=𝔊ArrMapg' 
              and q=ArrMaph' Af'
          ]
        category.cat_assoc_helper
          [
            where= 
              and h=f 
              and g=ArrMaph 
              and q=f' A𝔊ArrMapg
          ]
      from assms that g g' h h' f f' f'' show ?thesis
        unfolding F_def G_def A_def B_def C_def
        by 
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
    show "𝔊 CF ArrMap𝔊 CFCF CIdA = 𝔅CId𝔊 CF ObjMapA"
      if "A  𝔊 CFCF Obj" for A
    proof-
      from assms that obtain a b f 
        where A_def: "A = [a, b, f]"
          and "a  𝔄Obj" 
          and "b  𝔅Obj" 
          and "f : 𝔊ObjMapa ObjMapb"
        by auto
      from assms that this(2-4) show ?thesis
        unfolding A_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps
              cs_intro: cat_comma_cs_intros cat_cs_intros
          )
    qed
  qed 
    (
      use assms in
        cs_concl cs_shallow
            cs_simp: cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
    )+
qed

lemma cf_comma_proj_right_is_functor'[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα"
    and " : 𝔅 ↦↦Cα"
    and "𝔄' = 𝔊 CFCF "
  shows "𝔊 CF  : 𝔄' ↦↦Cα𝔅"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_functor)


subsubsection‹Opposite projections for a comma category›

lemma op_cf_comma_proj_left: 
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "op_cf (𝔊 CF ) = (op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 "
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔊ℌ: category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  show "op_cf (𝔊 CF ) = (op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 "
  proof(rule cf_eqI)
    show "op_cf (𝔊 CF ) : op_cat (𝔊 CFCF ) ↦↦Cαop_cat 𝔄"
      by 
        (
          cs_concl cs_shallow 
            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
        )
    then have ObjMap_dom_lhs: "𝒟 (op_cf (𝔊 CF )ObjMap) = 𝔊 CFCF Obj"
      and ArrMap_dom_lhs: "𝒟 (op_cf (𝔊 CF )ArrMap) = 𝔊 CFCF Arr"
      by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cat_op_simps)+
    show "(op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊  :
      op_cat (𝔊 CFCF ) ↦↦Cαop_cat 𝔄"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros)
    then have ObjMap_dom_rhs:
      "𝒟 (((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ObjMap) =
        𝔊 CFCF Obj"
      and ArrMap_dom_rhs: 
        "𝒟 (((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ArrMap) =
          𝔊 CFCF Arr"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps)+
    show
      "op_cf (𝔊 CF )ObjMap =
        ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ObjMap"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix A assume "A  𝔊 CFCF Obj"
      with assms obtain a b f 
        where A_def: "A = [a, b, f]"
          and a: "a  𝔄Obj" 
          and b: "b  𝔅Obj"
          and f: "f : 𝔊ObjMapa ObjMapb"
        by auto
      from a b f show 
        "op_cf (𝔊 CF )ObjMapA =
          ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ObjMapA"
        unfolding A_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
          )
    qed
      (
        cs_concl cs_shallow
          cs_simp: cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )+
    show 
      "op_cf (𝔊 CF )ArrMap =
        ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ArrMap"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix ABF assume "ABF  𝔊 CFCF Arr"
      then obtain A B where "ABF : A 𝔊 CFCF B" by auto
      with assms obtain a b f a' b' f' g h
        where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and f: "f : 𝔊ObjMapa ObjMapb"
          and f': "f' : 𝔊ObjMapa' ObjMapb'"
          and [symmetric, cat_cs_simps]: 
            "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      from g h f f' show "op_cf (𝔊 CF )ArrMapABF =
        ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ArrMapABF"
        unfolding ABF_def A_def B_def
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
          )
    qed 
      (
        cs_concl cs_shallow
          cs_simp: cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )+
  qed simp_all
qed

lemma op_cf_comma_proj_right:
  assumes "𝔊 : 𝔄 ↦↦Cα" and " : 𝔅 ↦↦Cα"
  shows "op_cf (𝔊 CF ) = (op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 "
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔊ℌ: category α 𝔊 CFCF 
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  show "op_cf (𝔊 CF ) = (op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 "
  proof(rule cf_eqI)
    show "op_cf (𝔊 CF ) : op_cat (𝔊 CFCF ) ↦↦Cαop_cat 𝔅"
      by 
        (
          cs_concl cs_shallow 
            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
        )
    then have ObjMap_dom_lhs: "𝒟 (op_cf (𝔊 CF )ObjMap) = 𝔊 CFCF Obj"
      and ArrMap_dom_lhs: "𝒟 (op_cf (𝔊 CF )ArrMap) = 𝔊 CFCF Arr"
      by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cat_op_simps)+
    show "(op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊  :
      op_cat (𝔊 CFCF ) ↦↦Cαop_cat 𝔅"
      by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros)
    then have ObjMap_dom_rhs:
      "𝒟 (((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ObjMap) =
        𝔊 CFCF Obj"
      and ArrMap_dom_rhs:
        "𝒟 (((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ArrMap) =
          𝔊 CFCF Arr"
      by (cs_concl cs_simp: cat_cs_simps cat_op_simps)+
    show
      "op_cf (𝔊 CF )ObjMap =
        ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ObjMap"
    proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
      fix A assume prems: "A  𝔊 CFCF Obj"
      with assms obtain a b f 
        where A_def: "A = [a, b, f]"
          and a: "a  𝔄Obj" 
          and b: "b  𝔅Obj"
          and f: "f : 𝔊ObjMapa ObjMapb"
        by auto
      from a b f show
        "op_cf (𝔊 CF )ObjMapA =
          ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ObjMapA"
        unfolding A_def
        by
          (
            cs_concl cs_shallow
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
          )
    qed
      (
        cs_concl cs_shallow
          cs_simp: cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )+
    show 
      "op_cf (𝔊 CF )ArrMap =
        ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ArrMap"
    proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
      fix ABF assume prems: "ABF  𝔊 CFCF Arr"
      then obtain A B where ABF: "ABF : A 𝔊 CFCF B" by auto
      with assms obtain a b f a' b' f' g h
        where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
          and A_def: "A = [a, b, f]"
          and B_def: "B = [a', b', f']"
          and g: "g : a 𝔄a'"
          and h: "h : b 𝔅b'"
          and f: "f : 𝔊ObjMapa ObjMapb"
          and f': "f' : 𝔊ObjMapa' ObjMapb'"
          and [symmetric, cat_cs_simps]: 
            "f' A𝔊ArrMapg = ArrMaph Af"
        by auto
      from g h f f' show "op_cf (𝔊 CF )ArrMapABF =
        ((op_cf ) CF (op_cf 𝔊) CF op_cf_comma 𝔊 )ArrMapABF"
        unfolding ABF_def A_def B_def
        by
          (
            cs_concl 
              cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
              cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
          )
    qed 
      (
        cs_concl cs_shallow
          cs_simp: cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )+
  qed simp_all
qed


subsubsection‹Projections for a tiny comma category›

lemma cf_comma_proj_left_is_tm_functor:
  assumes "𝔊 : 𝔄 ↦↦C.tmα" and " : 𝔅 ↦↦C.tmα"
  shows "𝔊 CF  : 𝔊 CFCF  ↦↦C.tmα𝔄"
proof(intro is_tm_functorI')

  interpret 𝔊: is_tm_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_tm_functor α 𝔅   by (rule assms(2))

  show Π_𝔊ℌ: "𝔊 CF  : 𝔊 CFCF  ↦↦Cα𝔄"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)

  interpret Π_𝔊ℌ: is_functor α 𝔊 CFCF  𝔄 𝔊 CF 
    by (rule Π_𝔊ℌ)
  interpret 𝔊ℌ: tiny_category α 𝔊 CFCF  
    by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_comma_cs_intros)

  show "𝔊 CF ObjMap  Vset α"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show " (𝔊 CF ObjMap)  Vset α"
    proof-
      note Π_𝔊ℌ.cf_ObjMap_vrange
      moreover have "𝔄Obj  Vset α" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)

  show "𝔊 CF ArrMap  Vset α"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show " (𝔊 CF ArrMap)  Vset α"
    proof-
      note Π_𝔊ℌ.cf_ArrMap_vrange
      moreover have "𝔄Arr  Vset α" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_left_components intro: cat_small_cs_intros)

qed

lemma cf_comma_proj_left_is_tm_functor'[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦C.tmα" 
    and " : 𝔅 ↦↦C.tmα"
    and "𝔊ℌ = 𝔊 CFCF "
  shows "𝔊 CF  : 𝔊ℌ ↦↦C.tmα𝔄"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_left_is_tm_functor)

lemma cf_comma_proj_right_is_tm_functor:
  assumes "𝔊 : 𝔄 ↦↦C.tmα" and " : 𝔅 ↦↦C.tmα"
  shows "𝔊 CF  : 𝔊 CFCF  ↦↦C.tmα𝔅"
proof(intro is_tm_functorI')

  interpret 𝔊: is_tm_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_tm_functor α 𝔅   by (rule assms(2))

  show Π_𝔊ℌ: "𝔊 CF  : 𝔊 CFCF  ↦↦Cα𝔅"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)

  interpret Π_𝔊ℌ: is_functor α 𝔊 CFCF  𝔅 𝔊 CF 
    by (rule Π_𝔊ℌ)
  interpret 𝔊ℌ: tiny_category α 𝔊 CFCF  
    by (cs_concl cs_shallow cs_intro: cat_small_cs_intros cat_comma_cs_intros)

  show "𝔊 CF ObjMap  Vset α"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show " (𝔊 CF ObjMap)  Vset α"
    proof-
      note Π_𝔊ℌ.cf_ObjMap_vrange
      moreover have "𝔅Obj  Vset α" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)

  show "𝔊 CF ArrMap  Vset α"
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show " (𝔊 CF ArrMap)  Vset α"
    proof-
      note Π_𝔊ℌ.cf_ArrMap_vrange
      moreover have "𝔅Arr  Vset α" by (intro cat_small_cs_intros)
      ultimately show ?thesis by auto
    qed
  qed (auto simp: cf_comma_proj_right_components intro: cat_small_cs_intros)

qed

lemma cf_comma_proj_right_is_tm_functor'[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦C.tmα" 
    and " : 𝔅 ↦↦C.tmα"
    and "𝔊ℌ = 𝔊 CFCF "
  shows "𝔊 CF  : 𝔊ℌ ↦↦C.tmα𝔅"
  using assms(1,2) unfolding assms(3) by (rule cf_comma_proj_right_is_tm_functor)


lemma cf_comp_cf_comma_proj_left_is_tm_functor[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "𝔉 : 𝔍 ↦↦C.tmα𝔊 CFCF "
  shows "𝔊 CF  CF 𝔉 : 𝔍 ↦↦C.tmα𝔄"
proof(intro is_tm_functorI')

  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔉: is_tm_functor α 𝔍 𝔊 CFCF  𝔉 by (rule assms(3))
  interpret 𝔊ℌ: is_functor α 𝔊 CFCF  𝔄 𝔊 CF 
    by (rule cf_comma_proj_left_is_functor[OF assms(1-2)])

  show "𝔊 CF  CF 𝔉 : 𝔍 ↦↦Cα𝔄"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)

  show "(𝔊 CF  CF 𝔉)ObjMap  Vset α"
    unfolding dghm_comp_components
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "vbrelation (𝔊 CF ObjMap  𝔉ObjMap)" by auto
    show "Limit α" by auto
    show "𝒟 (𝔊 CF ObjMap  𝔉ObjMap)  Vset α"
      by
        (
          cs_concl 
            cs_simp: V_cs_simps cat_cs_simps
            cs_intro: 𝔉.cf_ObjMap_vrange cat_small_cs_intros
        )
    show " (𝔊 CF ObjMap  𝔉ObjMap)  Vset α"
      unfolding vrange_vcomp
    proof-
      have "𝔊 CF ObjMap `  (𝔉ObjMap)  ((( (𝔉ObjMap))))"
      proof(intro vsubsetI)
        fix A assume prems: "A  𝔊 CF ObjMap `  (𝔉ObjMap)"
        then obtain abf 
          where abf_in_𝔉: "abf   (𝔉ObjMap)"
            and 𝔊ℌ_abf: "𝔊 CF ObjMapabf = A"
          by auto
        with 𝔉.ObjMap.vrange_atD obtain j 
          where "j  𝔍Obj" and 𝔉j: "𝔉ObjMapj = abf"
          by (force simp: 𝔉.cf_ObjMap_vdomain)
        from abf_in_𝔉 𝔉.cf_ObjMap_vrange have abf_in_𝔊ℌ: 
          "abf  𝔊 CFCF Obj" 
          by auto
        then obtain a b f where abf_def: "abf = [a, b, f]"
          by (elim cat_comma_ObjE[OF _ assms(1,2)])
        have "a  ((( (𝔉ObjMap))))"
        proof(intro VUnionI)
          from abf_in_𝔉 show "[a, b, f]   (𝔉ObjMap)"
            unfolding abf_def by auto
          show "0, a  [a, b, f]" by auto
          show "set {0, a}  0, a" unfolding vpair_def by simp
        qed auto
        with abf_in_𝔊ℌ show "A  ((((𝔉ObjMap))))"
          unfolding 𝔊ℌ_abf[symmetric] abf_def
          by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
      qed
      moreover have "((( (𝔉ObjMap))))  Vset α"
        by (intro VUnion_in_VsetI vrange_in_VsetI[OF 𝔉.tm_cf_ObjMap_in_Vset])
      ultimately show "𝔊 CF ObjMap `  (𝔉ObjMap)  Vset α" by auto
    qed
  qed

  show "(𝔊 CF  CF 𝔉)ArrMap  Vset α"
    unfolding dghm_comp_components
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "vbrelation (𝔊 CF ArrMap  𝔉ArrMap)" by auto
    show "Limit α" by auto
    show "𝒟 (𝔊 CF ArrMap  𝔉ArrMap)  Vset α"
      by
        (
          cs_concl
            cs_simp: V_cs_simps cat_cs_simps
            cs_intro: 𝔉.cf_ArrMap_vrange cat_small_cs_intros
        )
    show " (𝔊 CF ArrMap  𝔉ArrMap)  Vset α"
      unfolding vrange_vcomp
    proof-
      have 
        "𝔊 CF ArrMap `  (𝔉ArrMap)  
          (((((( (𝔉ArrMap)))))))"
      proof(intro vsubsetI)
        fix F assume prems: "F  𝔊 CF ArrMap `  (𝔉ArrMap)"
        then obtain ABF 
          where ABF_in_𝔉: "ABF   (𝔉ArrMap)"
            and 𝔊ℌ_ABF: "𝔊 CF ArrMapABF = F"
          by auto
        with 𝔉.ArrMap.vrange_atD obtain k 
          where "k  𝔍Arr" and 𝔉j: "𝔉ArrMapk = ABF"
          by (force simp: 𝔉.cf_ArrMap_vdomain)
        then obtain i j where "k : i 𝔍j" by auto
        from ABF_in_𝔉 𝔉.cf_ArrMap_vrange have ABF_in_𝔊ℌ: 
          "ABF  𝔊 CFCF Arr" 
          by auto
        then obtain A B where "ABF : A 𝔊 CFCF B" by auto
        with assms obtain a b f a' b' f' g h
          where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
          by (elim cat_comma_is_arrE[OF _ assms(1,2)])
        have "g  (((((( (𝔉ArrMap)))))))"
        proof(intro VUnionI)
          from ABF_in_𝔉 show 
            "[[a, b, f], [a', b', f'], [g, h]]   (𝔉ArrMap)"
            unfolding ABF_def by auto
          show "2, [g, h]  [[a, b, f], [a', b', f'], [g, h]]"
            by (auto simp: nat_omega_simps)
          show "set {2, [g, h]}  2, [g, h]"
            unfolding vpair_def by auto
          show "[g, h]  set {2, [g, h]}" by simp
          show "0, g  [g, h]" by auto
          show "set {0, g}  0, g" unfolding vpair_def by auto
        qed auto
        with ABF_in_𝔊ℌ show "F  (((((( (𝔉ArrMap)))))))"
          unfolding 𝔊ℌ_ABF[symmetric] ABF_def
          by (cs_concl cs_simp: cat_cs_simps cat_comma_cs_simps)
      qed
      moreover have "(((((( (𝔉ArrMap)))))))  Vset α"
        by (intro VUnion_in_VsetI vrange_in_VsetI[OF 𝔉.tm_cf_ArrMap_in_Vset])
      ultimately show "𝔊 CF ArrMap `  (𝔉ArrMap)  Vset α" by auto
    qed
  qed

qed

lemma cf_comp_cf_comma_proj_right_is_tm_functor[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and " : 𝔅 ↦↦Cα"
    and "𝔉 : 𝔍 ↦↦C.tmα𝔊 CFCF "
  shows "𝔊 CF  CF 𝔉 : 𝔍 ↦↦C.tmα𝔅"
proof(intro is_tm_functorI')

  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  interpret: is_functor α 𝔅   by (rule assms(2))
  interpret 𝔉: is_tm_functor α 𝔍 𝔊 CFCF  𝔉 by (rule assms(3))
  interpret 𝔊ℌ: is_functor α 𝔊 CFCF  𝔅 𝔊 CF 
    by (rule cf_comma_proj_right_is_functor[OF assms(1-2)])

  show "𝔊 CF  CF 𝔉 : 𝔍 ↦↦Cα𝔅"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)

  show "(𝔊 CF  CF 𝔉)ObjMap  Vset α"
    unfolding dghm_comp_components
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "vbrelation (𝔊 CF ObjMap  𝔉ObjMap)" by auto
    show "Limit α" by auto
    show "𝒟 (𝔊 CF ObjMap  𝔉ObjMap)  Vset α"
      by
        (
          cs_concl 
            cs_simp: V_cs_simps cat_cs_simps
            cs_intro: 𝔉.cf_ObjMap_vrange cat_small_cs_intros
        )
    show " (𝔊 CF ObjMap  𝔉ObjMap)  Vset α"
      unfolding vrange_vcomp
    proof-
      have "𝔊 CF ObjMap `  (𝔉ObjMap)  ((( (𝔉ObjMap))))"
      proof(intro vsubsetI)
        fix A assume prems: "A  (𝔊 CF )ObjMap `  (𝔉ObjMap)"
        then obtain abf 
          where abf_in_𝔉: "abf   (𝔉ObjMap)"
            and 𝔊ℌ_abf: "(𝔊 CF )ObjMapabf = A"
          by (auto simp: cf_comma_proj_right_ObjMap_vsv)
        with 𝔉.ObjMap.vrange_atD obtain j 
          where "j  𝔍Obj" and 𝔉j: "𝔉ObjMapj = abf"
          by (force simp: 𝔉.cf_ObjMap_vdomain)
        from abf_in_𝔉 𝔉.cf_ObjMap_vrange have abf_in_𝔊ℌ: 
          "abf  𝔊 CFCF Obj" 
          by auto
        then obtain a b f where abf_def: "abf = [a, b, f]"
          by (elim cat_comma_ObjE[OF _ assms(1,2)])
        have "b  ((( (𝔉ObjMap))))"
        proof(intro VUnionI)
          from abf_in_𝔉 show "[a, b, f]   (𝔉ObjMap)"
            unfolding abf_def by auto
          show "1, b  [a, b, f]" by (auto simp: nat_omega_simps)
          show "set {1, b}  1, b" unfolding vpair_def by simp
        qed auto
        with abf_in_𝔊ℌ show "A  ((((𝔉ObjMap))))"
          unfolding 𝔊ℌ_abf[symmetric] abf_def
          by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
      qed
      moreover have "((( (𝔉ObjMap))))  Vset α"
        by (intro VUnion_in_VsetI vrange_in_VsetI[OF 𝔉.tm_cf_ObjMap_in_Vset])
      ultimately show "𝔊 CF ObjMap `  (𝔉ObjMap)  Vset α" by auto
    qed
  qed

  show "(𝔊 CF  CF 𝔉)ArrMap  Vset α"
    unfolding dghm_comp_components
  proof(rule vbrelation.vbrelation_Limit_in_VsetI)
    show "vbrelation (𝔊 CF ArrMap  𝔉ArrMap)" by auto
    show "Limit α" by auto
    show "𝒟 (𝔊 CF ArrMap  𝔉ArrMap)  Vset α"
      by
        (
          cs_concl 
            cs_simp: V_cs_simps cat_cs_simps
            cs_intro: 𝔉.cf_ArrMap_vrange cat_small_cs_intros
        )
    show " (𝔊 CF ArrMap  𝔉ArrMap)  Vset α"
      unfolding vrange_vcomp
    proof-
      have 
        "𝔊 CF ArrMap `  (𝔉ArrMap)  
          (((((( (𝔉ArrMap)))))))"
      proof(intro vsubsetI)
        fix F assume prems: "F  𝔊 CF ArrMap `  (𝔉ArrMap)"
        then obtain ABF 
          where ABF_in_𝔉: "ABF   (𝔉ArrMap)"
            and 𝔊ℌ_ABF: "𝔊 CF ArrMapABF = F"
          by (auto simp: cf_comma_proj_right_ArrMap_vsv)
        with 𝔉.ArrMap.vrange_atD obtain k 
          where "k  𝔍Arr" and 𝔉j: "𝔉ArrMapk = ABF"
          by (force simp: 𝔉.cf_ArrMap_vdomain)
        then obtain i j where "k : i 𝔍j" by auto
        from ABF_in_𝔉 𝔉.cf_ArrMap_vrange have ABF_in_𝔊ℌ: 
          "ABF  𝔊 CFCF Arr" 
          by auto
        then obtain A B where "ABF : A 𝔊 CFCF B" by auto
        with assms obtain a b f a' b' f' g h
          where ABF_def: "ABF = [[a, b, f], [a', b', f'], [g, h]]"
          by (elim cat_comma_is_arrE[OF _ assms(1,2)])
        have "h  (((((( (𝔉ArrMap)))))))"
        proof(intro VUnionI)
          from ABF_in_𝔉 show 
            "[[a, b, f], [a', b', f'], [g, h]]   (𝔉ArrMap)"
            unfolding ABF_def by auto
          show "2, [g, h]  [[a, b, f], [a', b', f'], [g, h]]"
            by (auto simp: nat_omega_simps)
          show "set {2, [g, h]}  2, [g, h]"
            unfolding vpair_def by auto
          show "[g, h]  set {2, [g, h]}" by simp
          show "1, h  [g, h]" by (auto simp: nat_omega_simps)
          show "set {1, h}  1, h" unfolding vpair_def by auto
        qed auto
        with ABF_in_𝔊ℌ show "F  (((((( (𝔉ArrMap)))))))"
          unfolding 𝔊ℌ_ABF[symmetric] ABF_def
          by (cs_concl cs_shallow cs_simp: cat_cs_simps cat_comma_cs_simps)
      qed
      moreover have "(((((( (𝔉ArrMap)))))))  Vset α"
        by (intro VUnion_in_VsetI vrange_in_VsetI[OF 𝔉.tm_cf_ArrMap_in_Vset])
      ultimately show "𝔊 CF ArrMap `  (𝔉ArrMap)  Vset α" by auto
    qed
  qed

qed



subsection‹Comma categories constructed from a functor and an object›


subsubsection‹Definitions and elementary properties›


text‹See Chapter II-6 in cite"mac_lane_categories_2010".›

definition cat_cf_obj_comma :: "V  V  V" ((_ CF _) [1000, 1000] 999)
  where "𝔉 CF b  𝔉 CFCF (cf_const (cat_1 0 0) (𝔉HomCod) b)"

definition cat_obj_cf_comma :: "V  V  V" ((_ CF _) [1000, 1000] 999)
  where "b CF 𝔉  (cf_const (cat_1 0 0) (𝔉HomCod) b) CFCF 𝔉"


text‹Alternative forms of the definitions.›

lemma (in is_functor) cat_cf_obj_comma_def:
  "𝔉 CF b = 𝔉 CFCF (cf_const (cat_1 0 0) 𝔅 b)" 
  unfolding cat_cf_obj_comma_def cf_HomCod ..

lemma (in is_functor) cat_obj_cf_comma_def:
  "b CF 𝔉 = (cf_const (cat_1 0 0) 𝔅 b) CFCF 𝔉" 
  unfolding cat_obj_cf_comma_def cf_HomCod ..


text‹Size.›

lemma small_cat_cf_obj_comma_Obj[simp]: 
  "small {[a, 0, f] | a f. a  𝔄Obj  f : x 𝔊ObjMapa}"
  (is small ?afs)
proof-
  define Q where 
    "Q i = (if i = 0 then 𝔄Obj else if i = 1 then set {0} else Arr)" 
    for i
  have "?afs  elts (i set {0, 1, 2}. Q i)"
    unfolding Q_def
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, 
      elim exE conjE, 
      intro vproductI; 
      simp only:
    )
    fix a f show "𝒟 [a, 0, f] = set {0, 1, 2}"
      by (simp add: three nat_omega_simps)
  qed (force simp: nat_omega_simps)+
  then show "small ?afs" by (rule down)
qed

lemma small_cat_obj_cf_comma_Obj[simp]: 
  "small {[0, b, f] | b f. b  𝔅Obj  f : x 𝔊ObjMapb}"
  (is small ?bfs)
proof-
  define Q where
    "Q i = (if i = 0 then set {0} else if i = 1 then 𝔅Obj else Arr)" 
    for i
  have "?bfs  elts (i set {0, 1, 2}. Q i)"
    unfolding Q_def
  proof
    (
      intro subsetI, 
      unfold mem_Collect_eq, 
      elim exE conjE, 
      intro vproductI; 
      simp only:
    )
    fix a b f show "𝒟 [0, b, f] = set {0, 1, 2}"
      by (simp add: three nat_omega_simps)
  qed (force simp: nat_omega_simps)+
  then show "small ?bfs" by (rule down)
qed



subsubsection‹Objects›

lemma (in is_functor) cat_cf_obj_comma_ObjI[cat_comma_cs_intros]:
  assumes "A = [a, 0, f]" and "a  𝔄Obj" and "f : 𝔉ObjMapa 𝔅b"
  shows "A  𝔉 CF bObj"
  using assms(2,3)
  unfolding assms(1)
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_cf_obj_comma_def 
        cs_intro: cat_cs_intros vempty_is_zet cat_comma_ObjI
    )

lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ObjI

lemma (in is_functor) cat_obj_cf_comma_ObjI[cat_comma_cs_intros]:
  assumes "A = [0, a, f]" and "a  𝔄Obj" and "f : b 𝔅𝔉ObjMapa"
  shows "A  b CF 𝔉Obj"
  using assms(2,3)
  unfolding assms(1)
  by
    (
      cs_concl 
        cs_simp: cat_cs_simps cat_obj_cf_comma_def 
        cs_intro: vempty_is_zet cat_cs_intros cat_comma_ObjI
    )

lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ObjI

lemma (in is_functor) cat_cf_obj_comma_ObjD[dest]:
  assumes "[a, b', f]  𝔉 CF bObj" and "b  𝔅Obj"
  shows "a  𝔄Obj" and "b' = 0" and "f : 𝔉ObjMapa 𝔅b"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  note obj = cat_comma_ObjD[
      OF assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this
      ]
  from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
  moreover have "cf_const (cat_1 0 0) 𝔅 bObjMapb' = b"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show "a  𝔄Obj" "b' = 0" "f : 𝔉ObjMapa 𝔅b"
    using obj by auto
qed

lemmas [dest] = is_functor.cat_cf_obj_comma_ObjD[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ObjD[dest]:
  assumes "[b', a, f]  b CF 𝔉Obj" and "b  𝔅Obj"
  shows "a  𝔄Obj" and "b' = 0" and "f : b 𝔅𝔉ObjMapa"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  note obj = cat_comma_ObjD[
      OF assms(1)[unfolded cat_obj_cf_comma_def] this is_functor_axioms
      ]
  from obj[unfolded cat_1_components] have [cat_cs_simps]: "b' = 0" by simp
  moreover have "cf_const (cat_1 0 0) 𝔅 bObjMapb' = b"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show "a  𝔄Obj" "b' = 0" "f : b 𝔅𝔉ObjMapa"
    using obj by auto
qed

lemmas [dest] = is_functor.cat_obj_cf_comma_ObjD[rotated 1]

lemma (in is_functor) cat_cf_obj_comma_ObjE[elim]:
  assumes "A  𝔉 CF bObj" and "b  𝔅Obj"
  obtains a f 
    where "A = [a, 0, f]" 
      and "a  𝔄Obj" 
      and "f : 𝔉ObjMapa 𝔅b"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(1)[unfolded cat_cf_obj_comma_def] is_functor_axioms this 
  obtain a b' f 
    where "A = [a, b', f]"
      and a: "a  𝔄Obj"
      and b': "b'  cat_1 0 0Obj" 
      and f: "f : 𝔉ObjMapa 𝔅cf_const (cat_1 0 0) 𝔅 bObjMapb'"
    by auto
  moreover from b' have [cat_cs_simps]: "b' = 0"
    unfolding cat_1_components by auto
  moreover have "cf_const (cat_1 0 0) 𝔅 bObjMapb' = b"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show ?thesis using that by auto
qed

lemmas [elim] = is_functor.cat_cf_obj_comma_ObjE[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ObjE[elim]:
  assumes "A  b CF 𝔉Obj" and "b  𝔅Obj"
  obtains a f 
    where "A = [0, a, f]"
      and "a  𝔄Obj"
      and "f : b 𝔅𝔉ObjMapa"
proof-
  from assms(2) have "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(1)[unfolded cat_obj_cf_comma_def] is_functor_axioms this 
  obtain a b' f 
    where A_def: "A = [b', a, f]"
      and a: "a  𝔄Obj"
      and b': "b'  cat_1 0 0Obj" 
      and f: "f : cf_const (cat_1 0 0) 𝔅 bObjMapb' 𝔅𝔉ObjMapa"
    by auto
  moreover from b' have [cat_cs_simps]: "b' = 0" 
    unfolding cat_1_components by auto
  moreover have "cf_const (cat_1 0 0) 𝔅 bObjMapb' = b"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  ultimately show ?thesis using that by auto
qed

lemmas [elim] = is_functor.cat_obj_cf_comma_ObjE[rotated 1]


subsubsection‹Arrows›

lemma (in is_functor) cat_cf_obj_comma_ArrI[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" 
    and "F = [A, B, [g, 0]]"
    and "A = [a, 0, f]"
    and "B = [a', 0, f']"
    and "g : a 𝔄a'"
    and "f : 𝔉ObjMapa 𝔅b"
    and "f' : 𝔉ObjMapa' 𝔅b"
    and "f' A𝔅𝔉ArrMapg = f"
  shows "F  𝔉 CF bArr"
  unfolding cat_cf_obj_comma_def
proof(intro cat_comma_ArrI cat_comma_HomI)
  show "𝔉 : 𝔄 ↦↦Cα𝔅" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  from assms(1) show const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from vempty_is_zet show 0: "0 : 0 cat_1 0 00"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cat_1_CId_app cs_intro: cat_cs_intros
      )
  from assms(6) show 
    "f : 𝔉ObjMapa 𝔅cf_const (cat_1 0 0) 𝔅 bObjMap0"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(7) show 
    "f' : 𝔉ObjMapa' 𝔅cf_const (cat_1 0 0) 𝔅 bObjMap0"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 0 assms(6) show 
    "f' A𝔅𝔉ArrMapg = cf_const (cat_1 0 0) 𝔅 bArrMap0 A𝔅f"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros
      )
  from const assms(5,6) show "A  𝔉 CFCF (cf_const (cat_1 0 0) 𝔅 b)Obj"
    by (fold cat_cf_obj_comma_def)
      (cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
  from const assms(5,7) show "B  𝔉 CFCF (cf_const (cat_1 0 0) 𝔅 b)Obj"
    by (fold cat_cf_obj_comma_def)
      (
        cs_concl cs_shallow 
          cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed (intro assms)+

lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_ArrI

lemma (in is_functor) cat_obj_cf_comma_ArrI[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" 
    and "F = [A, B, [0, g]]"
    and "A = [0, a, f]"
    and "B = [0, a', f']"
    and "g : a 𝔄a'"
    and "f : b 𝔅𝔉ObjMapa"
    and "f' : b 𝔅𝔉ObjMapa' "
    and "𝔉ArrMapg A𝔅f = f'"
  shows "F  b CF 𝔉Arr"
  unfolding cat_obj_cf_comma_def
proof(intro cat_comma_ArrI cat_comma_HomI)
  show "𝔉 : 𝔄 ↦↦Cα𝔅" by (cs_concl cs_shallow cs_intro: cat_cs_intros)
  from assms(1) show const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from vempty_is_zet show 0: "0 : 0 cat_1 0 00"
    by (cs_concl cs_shallow cs_simp: cat_1_CId_app cs_intro: cat_cs_intros)
  from assms(6) show 
    "f : cf_const (cat_1 0 0) 𝔅 bObjMap0 𝔅𝔉ObjMapa"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from assms(7) show 
    "f' : cf_const (cat_1 0 0) 𝔅 bObjMap0 𝔅𝔉ObjMapa'"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 0 assms(7) show 
    "f' A𝔅cf_const (cat_1 0 0) 𝔅 bArrMap0 = 𝔉ArrMapg A𝔅f"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps assms(8) cs_intro: cat_cs_intros
      )
  from const assms(5,6) show "A  (cf_const (cat_1 0 0) 𝔅 b) CFCF 𝔉Obj"
    by (fold cat_obj_cf_comma_def)
      (cs_concl cs_simp: assms(3) cs_intro: cat_cs_intros cat_comma_cs_intros)
  from const assms(5,7) show "B  (cf_const (cat_1 0 0) 𝔅 b) CFCF 𝔉Obj"
    by (fold cat_obj_cf_comma_def)
      (
        cs_concl cs_shallow 
          cs_simp: assms(4) cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed (intro assms)+

lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_ArrI

lemma (in is_functor) cat_cf_obj_comma_ArrE[elim]:
  assumes "F  𝔉 CF bArr" and "b  𝔅Obj"
  obtains A B a f a' f' g
    where "F = [A, B, [g, 0]]"
      and "A = [a, 0, f]"
      and "B = [a', 0, f']"
      and "g : a 𝔄a'"
      and "f : 𝔉ObjMapa 𝔅b"
      and "f' : 𝔉ObjMapa' 𝔅b"
      and "f' A𝔅𝔉ArrMapg = f"
      and "A  𝔉 CF bObj"
      and "B  𝔉 CF bObj"
proof-
  from cat_comma_ArrE[OF assms(1)[unfolded cat_cf_obj_comma_def]] 
  obtain A B 
    where F: "F  cat_comma_Hom 𝔉 (cf_const (cat_1 0 0) 𝔅 b) A B"
      and A: "A  𝔉 CFCF (cf_const (cat_1 0 0) 𝔅 b)Obj"
      and B: "B  𝔉 CFCF (cf_const (cat_1 0 0) 𝔅 b)Obj"
    by auto
  from assms(2) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from F obtain a b'' f a' b' f' g h
    where F_def: "F = [A, B, [g, h]]"
      and A_def: "A = [a, b'', f]"
      and B_def: "B = [a', b', f']"
      and g: "g : a 𝔄a'"
      and h: "h : b'' cat_1 0 0b'"
      and f: "f : 𝔉ObjMapa 𝔅cf_const (cat_1 0 0) 𝔅 bObjMapb''"
      and f': "f' : 𝔉ObjMapa' 𝔅cf_const (cat_1 0 0) 𝔅 bObjMapb'"
      and f_def: 
        "f' A𝔅𝔉ArrMapg = cf_const (cat_1 0 0) 𝔅 bArrMaph A𝔅f"
    by (elim cat_comma_HomE[OF _ is_functor_axioms const]) blast
  note hb'b'' = cat_1_is_arrD[OF h]
  from F_def have F_def: "F = [A, B, [g, 0]]" 
    unfolding hb'b'' by simp
  from A_def have A_def: "A = [a, 0, f]"
    unfolding hb'b'' by simp
  from B_def have B_def: "B = [a', 0, f']"
    unfolding hb'b'' by simp
  from f have f: "f : 𝔉ObjMapa 𝔅b"
    unfolding hb'b'' 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f' have f': "f' : 𝔉ObjMapa' 𝔅b"
    unfolding hb'b'' 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f_def f f' g h have f_def: "f' A𝔅𝔉ArrMapg = f"
    unfolding hb'b'' 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 
    that F_def A_def B_def g f f' f_def  
    B[folded cat_cf_obj_comma_def] A[folded cat_cf_obj_comma_def]
  show ?thesis
    by blast
qed

lemmas [elim] = is_functor.cat_cf_obj_comma_ArrE[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ArrE[elim]:
  assumes "F  b CF 𝔉Arr" and "b  𝔅Obj"
  obtains A B a f a' f' g
    where "F = [A, B, [0, g]]"
      and "A = [0, a, f]"
      and "B = [0, a', f']"
      and "g : a 𝔄a'"
      and "f : b 𝔅𝔉ObjMapa"
      and "f' : b 𝔅𝔉ObjMapa'"
      and "𝔉ArrMapg A𝔅f = f'"
      and "A  b CF 𝔉Obj"
      and "B  b CF 𝔉Obj"
proof-
  from cat_comma_ArrE[OF assms(1)[unfolded cat_obj_cf_comma_def]] 
  obtain A B 
    where F: "F  cat_comma_Hom (cf_const (cat_1 0 0) 𝔅 b) 𝔉 A B"
      and A: "A  (cf_const (cat_1 0 0) 𝔅 b) CFCF 𝔉Obj"
      and B: "B  (cf_const (cat_1 0 0) 𝔅 b) CFCF 𝔉Obj"
    by auto
  from assms(2) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from F obtain a b'' f a' b' f' h g 
    where F_def: "F = [A, B, [h, g]]"
      and A_def: "A = [b', a, f]"
      and B_def: "B = [b'', a', f']"
      and h: "h : b' cat_1 0 0b''"
      and g: "g : a 𝔄a'"
      and f: "f : cf_const (cat_1 0 0) 𝔅 bObjMapb' 𝔅𝔉ObjMapa"
      and f': "f' : cf_const (cat_1 0 0) 𝔅 bObjMapb'' 𝔅𝔉ObjMapa'"
      and f'_def: 
        "f' A𝔅cf_const (cat_1 0 0) 𝔅 bArrMaph = 𝔉ArrMapg A𝔅f"
    by (elim cat_comma_HomE[OF _ const is_functor_axioms]) blast
  note hb'b'' = cat_1_is_arrD[OF h]
  from F_def have F_def: "F = [A, B, [0, g]]" 
    unfolding hb'b'' by simp
  from A_def have A_def: "A = [0, a, f]" unfolding hb'b'' by simp
  from B_def have B_def: "B = [0, a', f']" unfolding hb'b'' by simp
  from f have f: "f : b 𝔅𝔉ObjMapa"
    unfolding hb'b'' 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f' have f': "f' : b 𝔅𝔉ObjMapa'"
    unfolding hb'b'' 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from f'_def f f' g h have f'_def[symmetric]: "f' = 𝔉ArrMapg A𝔅f"
    unfolding hb'b'' 
    by (cs_prems cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  from 
    that F_def A_def B_def g f f' f'_def  
    A[folded cat_obj_cf_comma_def] B[folded cat_obj_cf_comma_def] 
  show ?thesis
    by blast
qed

lemmas [elim] = is_functor.cat_obj_cf_comma_ArrE

lemma (in is_functor) cat_cf_obj_comma_ArrD[dest]: 
  assumes "[[a, b', f], [a', b'', f'], [g, h]]  𝔉 CF bArr" 
    and "b  𝔅Obj"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a 𝔄a'"
    and "f : 𝔉ObjMapa 𝔅b"
    and "f' : 𝔉ObjMapa' 𝔅b"
    and "f' A𝔅𝔉ArrMapg = f"
    and "[a, b', f]  𝔉 CF bObj"
    and "[a', b'', f']  𝔉 CF bObj"
  using cat_cf_obj_comma_ArrE[OF assms] by auto

lemmas [dest] = is_functor.cat_cf_obj_comma_ArrD[rotated 1]

lemma (in is_functor) cat_obj_cf_comma_ArrD[dest]: 
  assumes "[[b', a, f], [b'', a', f'], [h, g]]  b CF 𝔉Arr"
    and "b  𝔅Obj"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a 𝔄a'"
    and "f : b 𝔅𝔉ObjMapa"
    and "f' : b 𝔅𝔉ObjMapa'"
    and "𝔉ArrMapg A𝔅f = f'"
    and "[b', a, f]  b CF 𝔉Obj"
    and "[b'', a', f']  b CF 𝔉Obj"
  using cat_obj_cf_comma_ArrE[OF assms] by auto

lemmas [dest] = is_functor.cat_obj_cf_comma_ArrD


subsubsection‹Domain›

lemma cat_cf_obj_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF bDom)"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Dom_vdomain[cat_comma_cs_simps]:
  "𝒟 (𝔉 CF bDom) = 𝔉 CF bArr"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Dom_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]" and "ABF  𝔉 CF bArr"
  shows "𝔉 CF bDomABF = A"
  using assms(2) 
  unfolding assms(1) cat_cf_obj_comma_def cat_comma_components 
  by simp

lemma (in is_functor) cat_cf_obj_comma_Dom_vrange:
  assumes "b  𝔅Obj"
  shows " (𝔉 CF bDom)  𝔉 CF bObj"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Dom_vrange[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma cat_obj_cf_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (b CF 𝔉Dom)"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Dom_vdomain[cat_comma_cs_simps]:
  "𝒟 (b CF 𝔉Dom) = b CF 𝔉Arr"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Dom_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]" and "ABF  b CF 𝔉Arr"
  shows "b CF 𝔉DomABF = A"
  using assms(2)
  unfolding assms(1) cat_obj_cf_comma_def cat_comma_components 
  by simp

lemma (in is_functor) cat_obj_cf_comma_Dom_vrange:
  assumes "b  𝔅Obj"
  shows " (b CF 𝔉Dom)  b CF 𝔉Obj"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Dom_vrange[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed


subsubsection‹Codomain›

lemma cat_cf_obj_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF bCod)"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Cod_vdomain[cat_comma_cs_simps]:
  "𝒟 (𝔉 CF bCod) = 𝔉 CF bArr"
  unfolding cat_cf_obj_comma_def cat_comma_components by simp

lemma cat_cf_obj_comma_Cod_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]" and "ABF  𝔉 CF bArr"
  shows "𝔉 CF bCodABF = B"
  using assms(2) 
  unfolding assms(1) cat_cf_obj_comma_def cat_comma_components 
  by (simp add: nat_omega_simps)

lemma (in is_functor) cat_cf_obj_comma_Cod_vrange:
  assumes "b  𝔅Obj"
  shows " (𝔉 CF bCod)  𝔉 CF bObj"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Cod_vrange[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma cat_obj_cf_comma_Cod_vsv[cat_comma_cs_intros]: "vsv (b CF 𝔉Cod)"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Cod_vdomain[cat_comma_cs_simps]:
  "𝒟 (b CF 𝔉Cod) = b CF 𝔉Arr"
  unfolding cat_obj_cf_comma_def cat_comma_components by simp

lemma cat_obj_cf_comma_Cod_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]" and "ABF  b CF 𝔉Arr"
  shows "b CF 𝔉CodABF = B"
  using assms(2)
  unfolding assms(1) cat_obj_cf_comma_def cat_comma_components 
  by (simp add: nat_omega_simps)

lemma (in is_functor) cat_obj_cf_comma_Cod_vrange:
  assumes "b  𝔅Obj"
  shows " (b CF 𝔉Dom)  b CF 𝔉Obj"
proof-  
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Dom_vrange[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed


subsubsection‹Arrow with a domain and a codomain›

lemma (in is_functor) cat_cf_obj_comma_is_arrI[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
    and "ABF = [A, B, F]"
    and "A = [a, 0, f]"
    and "B = [a', 0, f']"
    and "F = [g, 0]"
    and "g : a 𝔄a'"
    and "f : 𝔉ObjMapa 𝔅b"
    and "f' : 𝔉ObjMapa' 𝔅b"
    and "f' A𝔅𝔉ArrMapg = f"
  shows "ABF : A 𝔉 CF bB"
proof(intro is_arrI)
  from assms(1,6,7,8) show "ABF  𝔉 CF bArr"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros
      )
  with assms(2) show "𝔉 CF bDomABF = A" "𝔉 CF bCodABF = B"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)+
qed

lemmas [cat_comma_cs_intros] = is_functor.cat_cf_obj_comma_is_arrI

lemma (in is_functor) cat_obj_cf_comma_is_arrI[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
    and "ABF = [A, B, F]"
    and "A = [0, a, f]"
    and "B = [0, a', f']"
    and "F = [0, g]"
    and "g : a 𝔄a'"
    and "f : b 𝔅𝔉ObjMapa"
    and "f' : b 𝔅𝔉ObjMapa'"
    and "𝔉ArrMapg A𝔅f = f'"
  shows "ABF : A b CF 𝔉B"
proof(intro is_arrI)
  from assms(1,6,7,8) show "ABF  b CF 𝔉Arr"
    by 
      (
        cs_concl cs_shallow 
          cs_simp: assms(2,3,4,5,9) cs_intro: cat_comma_cs_intros
      )
  with assms(2) show "b CF 𝔉DomABF = A" "b CF 𝔉CodABF = B"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)+
qed

lemmas [cat_comma_cs_intros] = is_functor.cat_obj_cf_comma_is_arrI

lemma (in is_functor) cat_cf_obj_comma_is_arrD[dest]:
  assumes "[[a, b', f], [a', b'', f'], [g, h]] :
    [a, b', f] 𝔉 CF b[a', b'', f']"
    and "b  𝔅Obj"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a 𝔄a'"
    and "f : 𝔉ObjMapa 𝔅b"
    and "f' : 𝔉ObjMapa' 𝔅b"
    and "f' A𝔅𝔉ArrMapg = f"
    and "[a, b', f]  𝔉 CF bObj"
    and "[a', b'', f']  𝔉 CF bObj"
  by (intro cat_cf_obj_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+

lemma (in is_functor) cat_obj_cf_comma_is_arrD[dest]:
  assumes "[[b', a, f], [b'', a', f'], [h, g]] :
    [b', a, f] b CF 𝔉[b'', a', f']"
    and "b  𝔅Obj"
  shows "b' = 0"
    and "b'' = 0"
    and "h = 0"
    and "g : a 𝔄a'"
    and "f : b 𝔅𝔉ObjMapa"
    and "f' : b 𝔅𝔉ObjMapa'"
    and "𝔉ArrMapg A𝔅f = f'"
    and "[b', a, f]  b CF 𝔉Obj"
    and "[b'', a', f']  b CF 𝔉Obj"
  by (intro cat_obj_cf_comma_ArrD[OF is_arrD(1)[OF assms(1)] assms(2)])+

lemmas [dest] = is_functor.cat_obj_cf_comma_is_arrD

lemma (in is_functor) cat_cf_obj_comma_is_arrE[elim]:
  assumes "ABF : A 𝔉 CF bB" and "b  𝔅Obj"
  obtains a f a' f' g 
    where "ABF = [[a, 0, f], [a', 0, f'], [g, 0]]"
      and "A = [a, 0, f]"
      and "B = [a', 0, f']"
      and "g : a 𝔄a'"
      and "f : 𝔉ObjMapa 𝔅b"
      and "f' : 𝔉ObjMapa' 𝔅b"
      and "f' A𝔅𝔉ArrMapg = f"
      and "A  𝔉 CF bObj"
      and "B  𝔉 CF bObj"
proof-
  note ABF = is_arrD[OF assms(1)]
  from ABF(1) obtain C D a f a' f' g 
    where ABF_def: "ABF = [C, D, [g, 0]]"
      and C_def: "C = [a, 0, f]"
      and D_def: "D = [a', 0, f']"
      and g: "g : a 𝔄a'"
      and f: "f : 𝔉ObjMapa 𝔅b"
      and f': "f' : 𝔉ObjMapa' 𝔅b"
      and f_def: "f' A𝔅𝔉ArrMapg = f" 
      and C: "C  𝔉 CF bObj" 
      and D: "D  𝔉 CF bObj"
    by (elim cat_cf_obj_comma_ArrE[OF _ assms(2)])
  from ABF(2) assms(2) C_def D_def g f f' f_def have [simp]: "C = A"
    unfolding ABF_def 
    by 
      ( 
        cs_prems cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
      )
  from ABF(3) assms(2) C_def D_def g f f' f_def have [simp]: "D = B"
    unfolding ABF_def 
    by 
      (
        cs_prems cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
      )
  from that ABF_def C_def D_def g f f' f_def C D show ?thesis by auto
qed

lemmas [elim] = is_functor.cat_cf_obj_comma_is_arrE

lemma (in is_functor) cat_obj_cf_comma_is_arrE[elim]:
  assumes "ABF : A b CF 𝔉B" and "b  𝔅Obj"
  obtains a f a' f' g
    where "ABF = [[0, a, f], [0, a', f'], [0, g]]"
      and "A = [0, a, f]"
      and "B = [0, a', f']"
      and "g : a 𝔄a'"
      and "f : b 𝔅𝔉ObjMapa"
      and "f' : b 𝔅𝔉ObjMapa'"
      and "𝔉ArrMapg A𝔅f = f'"
      and "A  b CF 𝔉Obj"
      and "B  b CF 𝔉Obj"
proof-
  note ABF = is_arrD[OF assms(1)]
  from ABF(1) obtain C D a f a' f' g 
    where ABF_def: "ABF = [C, D, [0, g]]"
      and C_def: "C = [0, a, f]"
      and D_def: "D = [0, a', f']"
      and g: "g : a 𝔄a'"
      and f: "f : b 𝔅𝔉ObjMapa"
      and f': "f' : b 𝔅𝔉ObjMapa'"
      and f'_def: "𝔉ArrMapg A𝔅f = f'" 
      and C: "C  b CF 𝔉Obj" 
      and D: "D  b CF 𝔉Obj"
    by (elim cat_obj_cf_comma_ArrE[OF _ assms(2)])
  from ABF(2) assms(2) C_def D_def g f f' f'_def have [simp]: "C = A"
    unfolding ABF_def 
    by 
      (
        cs_prems cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
      )
  from ABF(3) assms(2) C_def D_def g f f' f'_def have [simp]: "D = B"
    unfolding ABF_def 
    by 
      (
        cs_prems cs_shallow 
          cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
      )
  from that ABF_def C_def D_def g f f' f'_def C D show ?thesis by auto
qed

lemmas [elim] = is_functor.cat_obj_cf_comma_is_arrE


subsubsection‹Composition›

lemma cat_cf_obj_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF bComp)"
  unfolding cat_cf_obj_comma_def 
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma cat_obj_cf_comma_Comp_vsv[cat_comma_cs_intros]: "vsv (b CF 𝔉Comp)"
  unfolding cat_obj_cf_comma_def 
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cat_cf_obj_comma_Comp_app[cat_comma_cs_simps]:
  assumes "b  𝔅Obj" 
    and "BCG = [B, C, [g', h']]"
    and "ABF = [A, B, [g, h]]"
    and "BCG : B 𝔉 CF bC" 
    and "ABF : A 𝔉 CF bB"
  shows "BCG A𝔉 CF bABF = [A, C, [g' A𝔄g, 0]]"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(4) obtain a f a' f' g
    where BCG_def: "BCG = [[a, 0, f], [a', 0, f'], [g, 0]]"
    by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
  from assms(5) obtain a f a' f' g
    where ABF_def: "ABF = [[a, 0, f], [a', 0, f'], [g, 0]]"
    by (elim cat_cf_obj_comma_is_arrE[OF _ assms(1)])
  from assms(2)[unfolded BCG_def] assms(3)[unfolded ABF_def] have [cat_cs_simps]:
    "h' = 0" "h = 0"
    by simp_all
  have "h' Acat_1 0 0h = 0" by (cs_concl cs_shallow cs_simp: cat_cs_simps)
  show ?thesis
    by 
      (
        rule cat_comma_Comp_app
          [
            OF 
              is_functor_axioms 
              const 
              assms(2,3) 
              assms(4)[unfolded cat_cf_obj_comma_def] 
              assms(5)[unfolded cat_cf_obj_comma_def],
            folded cat_cf_obj_comma_def,
            unfolded cat_cs_simps
          ]
      )
qed

lemma (in is_functor) cat_obj_cf_comma_Comp_app[cat_comma_cs_simps]:
  assumes "b  𝔅Obj"
    and "BCG = [B, C, [h', g']]"
    and "ABF = [A, B, [h, g]]"
    and "BCG : B b CF 𝔉C" 
    and "ABF : A b CF 𝔉B"
  shows "BCG Ab CF 𝔉ABF = [A, C, [0, g' A𝔄g]]"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(4) obtain a f a' f' g
    where BCG_def: "BCG = [[0, a, f], [0, a', f'], [0, g]]"
    by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
  from assms(5) obtain a f a' f' g
    where ABF_def: "ABF = [[0, a, f], [0, a', f'], [0, g]]"
    by (elim cat_obj_cf_comma_is_arrE[OF _ assms(1)])
  from assms(2)[unfolded BCG_def] assms(3)[unfolded ABF_def] have [cat_cs_simps]:
    "h' = 0" "h = 0"
    by simp_all
  have "h' Acat_1 0 0h = 0" by (cs_concl cs_shallow cs_simp: cat_cs_simps) 
  show ?thesis
    by 
      (
        rule cat_comma_Comp_app
          [
            OF 
              const 
              is_functor_axioms
              assms(2,3) 
              assms(4)[unfolded cat_obj_cf_comma_def] 
              assms(5)[unfolded cat_obj_cf_comma_def],
            folded cat_obj_cf_comma_def,
            unfolded cat_cs_simps
          ]
      )
qed

lemma (in is_functor) cat_cf_obj_comma_Comp_is_arr[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" 
    and "BCG : B 𝔉 CF bC" 
    and "ABF : A 𝔉 CF bB"
  shows "BCG A𝔉 CF bABF : A 𝔉 CF bC"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Comp_is_arr
          [
            OF 
              is_functor_axioms 
              const 
              assms(2)[unfolded cat_cf_obj_comma_def]
              assms(3)[unfolded cat_cf_obj_comma_def],
            folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) cat_obj_cf_comma_Comp_is_arr[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" 
    and "BCG : B b CF 𝔉C" 
    and "ABF : A b CF 𝔉B"
  shows "BCG Ab CF 𝔉ABF : A b CF 𝔉C"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_Comp_is_arr
          [
            OF 
              const 
              is_functor_axioms 
              assms(2)[unfolded cat_obj_cf_comma_def]
              assms(3)[unfolded cat_obj_cf_comma_def],
            folded cat_obj_cf_comma_def
          ]
      )
qed


subsubsection‹Identity›

lemma cat_cf_obj_comma_CId_vsv[cat_comma_cs_intros]: "vsv (𝔉 CF bCId)"
  unfolding cat_cf_obj_comma_def 
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma cat_obj_cf_comma_CId_vsv[cat_comma_cs_intros]: "vsv (b CF 𝔉CId)"
  unfolding cat_obj_cf_comma_def 
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cat_cf_obj_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "b  𝔅Obj"
  shows "𝒟 (𝔉 CF bCId) = 𝔉 CF bObj"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule cat_comma_CId_vdomain[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) cat_obj_cf_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "b  𝔅Obj"
  shows "𝒟 (b CF 𝔉CId) = b CF 𝔉Obj"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show "𝒟 (b CF 𝔉CId) = b CF 𝔉Obj"
    by 
      (
        rule cat_comma_CId_vdomain[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_functor) cat_cf_obj_comma_CId_app[cat_comma_cs_simps]:
  assumes "b  𝔅Obj" and "A = [a, b', f]" and "A  𝔉 CF bObj"
  shows "𝔉 CF bCIdA = [A, A, [𝔄CIda, 0]]"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(3,2) have b'_def: "b' = 0"
    by (auto elim: cat_cf_obj_comma_ObjE[OF _ assms(1)])
  have [cat_cs_simps]: "cat_1 0 0CIdb' = 0" 
    unfolding cat_1_components b'_def by simp
  show ?thesis
    by 
      ( 
        rule cat_comma_CId_app
          [
            OF 
              is_functor_axioms 
              const
              assms(2,3)[unfolded cat_cf_obj_comma_def],  
            unfolded cat_cf_obj_comma_def[symmetric] cat_cs_simps
          ]
        )
qed

lemma (in is_functor) cat_obj_cf_comma_CId_app[cat_comma_cs_simps]:
  assumes "b  𝔅Obj" and "A = [b', a, f]" and "A  b CF 𝔉Obj"
  shows "b CF 𝔉CIdA = [A, A, [0, 𝔄CIda]]"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  from assms(3,2) have b'_def: "b' = 0"
    by (auto elim: cat_obj_cf_comma_ObjE[OF _ assms(1)])
  have [cat_cs_simps]: "cat_1 0 0CIdb' = 0" 
    unfolding cat_1_components b'_def by simp
  show ?thesis
    by 
      ( 
        rule cat_comma_CId_app
          [
            OF 
              const
              is_functor_axioms 
              assms(2,3)[unfolded cat_obj_cf_comma_def],  
            unfolded cat_obj_cf_comma_def[symmetric] cat_cs_simps
          ]
        )
qed


subsubsection‹
Comma categories constructed from a functor and an object are categories
›

lemma (in is_functor) category_cat_cf_obj_comma[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
  shows "category α (𝔉 CF b)"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule category_cat_comma[
          OF is_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemmas [cat_comma_cs_intros] = is_functor.category_cat_cf_obj_comma

lemma (in is_functor) category_cat_obj_cf_comma[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
  shows "category α (b CF 𝔉)"
proof-
  from assms(1) have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_cs_intros)
  show ?thesis
    by 
      (
        rule category_cat_comma[
          OF const is_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed

lemmas [cat_comma_cs_intros] = is_functor.category_cat_obj_cf_comma


subsubsection‹Tiny comma categories constructed from a functor and an object›

lemma (in is_tm_functor) tiny_category_cat_cf_obj_comma[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
  shows "tiny_category α (𝔉 CF b)"
proof-
  from assms(1) have const: 
    "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_small_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule tiny_category_cat_comma[
          OF is_tm_functor_axioms const, folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_tm_functor) tiny_category_cat_obj_cf_comma[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
  shows "tiny_category α (b CF 𝔉)"
proof-
  from assms(1) have const: 
    "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmα𝔅"
    by (cs_concl cs_intro: vempty_is_zet cat_small_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule tiny_category_cat_comma[
          OF const is_tm_functor_axioms, folded cat_obj_cf_comma_def
          ]
      )
qed



subsection‹
Opposite comma category functors for the comma categories
constructed from a functor and an object
›


subsubsection‹Definitions and elementary properties›

definition op_cf_obj_comma :: "V  V  V"
  where "op_cf_obj_comma 𝔉 b =
    op_cf_comma 𝔉 (cf_const (cat_1 0 0) (𝔉HomCod) b)"

definition op_obj_cf_comma :: "V  V  V"
  where "op_obj_cf_comma b 𝔉 =
    op_cf_comma (cf_const (cat_1 0 0) (𝔉HomCod) b) 𝔉"


text‹Alternative forms of the definitions.›

lemma (in is_functor) op_cf_obj_comma_def: 
  "op_cf_obj_comma 𝔉 b = op_cf_comma 𝔉 (cf_const (cat_1 0 0) 𝔅 b)"
  unfolding op_cf_obj_comma_def cat_cs_simps by simp

lemma (in is_functor) op_obj_cf_comma_def:
  "op_obj_cf_comma b 𝔉 = op_cf_comma (cf_const (cat_1 0 0) 𝔅 b) 𝔉"
  unfolding op_obj_cf_comma_def cat_cs_simps by simp


subsubsection‹Object map›

lemma op_cf_obj_comma_ObjMap_vsv[cat_comma_cs_intros]:
  "vsv (op_cf_obj_comma 𝔉 bObjMap)"
  unfolding op_cf_obj_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
    )

lemma op_obj_cf_comma_ObjMap_vsv[cat_comma_cs_intros]:
  "vsv (op_obj_cf_comma b 𝔉ObjMap)"
  unfolding op_obj_cf_comma_def
  by
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
    )

lemma (in is_functor) op_cf_obj_comma_ObjMap_vdomain[cat_comma_cs_simps]:
  "𝒟 (op_cf_obj_comma 𝔉 bObjMap) = 𝔉 CF bObj"
  unfolding op_cf_obj_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cat_cf_obj_comma_def[symmetric]
    )

lemma (in is_functor) op_obj_cf_comma_ObjMap_vdomain[cat_comma_cs_simps]:
  "𝒟 (op_obj_cf_comma b 𝔉ObjMap) = b CF 𝔉Obj"
  unfolding op_obj_cf_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cat_obj_cf_comma_def[symmetric]
    )

lemma (in is_functor) op_cf_obj_comma_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, 0, f]" and "b  𝔅Obj" and "A  𝔉 CF bObj"
  shows "op_cf_obj_comma 𝔉 bObjMapA = [0, a, f]"
proof-
  have a: "a  𝔄Obj" and f: "f : 𝔉ObjMapa 𝔅b"
    by (intro cat_cf_obj_comma_ObjD[OF assms(3)[unfolded assms(1)] assms(2)])+
  from assms(2) a f show ?thesis
    using assms(2)
    unfolding assms(1) op_cf_obj_comma_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_comma_cs_simps
          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros
      )
qed

lemma (in is_functor) op_obj_cf_comma_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [0, a, f]" and "b  𝔅Obj" and "A  b CF 𝔉Obj"
  shows "op_obj_cf_comma b 𝔉 ObjMapA = [a, 0, f]"
proof-
  have a: "a  𝔄Obj" and f: "f : b 𝔅𝔉ObjMapa"
    by (intro cat_obj_cf_comma_ObjD[OF assms(3)[unfolded assms(1)] assms(2)])+
  from assms(2) a f show ?thesis
    using assms(2)
    unfolding assms(1) op_obj_cf_comma_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_comma_cs_simps
          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros
      )
qed


subsubsection‹Arrow map›

lemma op_cf_obj_comma_ArrMap_vsv[cat_comma_cs_intros]:
  "vsv (op_cf_obj_comma 𝔉 bArrMap)"
  unfolding op_cf_obj_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
    )

lemma op_obj_cf_comma_ArrMap_vsv[cat_comma_cs_intros]:
  "vsv (op_obj_cf_comma b 𝔉ArrMap)"
  unfolding op_obj_cf_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cs_intro: cat_comma_cs_intros
    )

lemma (in is_functor) op_cf_obj_comma_ArrMap_vdomain[cat_comma_cs_simps]:
  "𝒟 (op_cf_obj_comma 𝔉 bArrMap) = 𝔉 CF bArr"
  unfolding op_cf_obj_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cat_cf_obj_comma_def[symmetric]
    )

lemmas [cat_comma_cs_simps] = is_functor.op_cf_obj_comma_ArrMap_vdomain

lemma (in is_functor) op_obj_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]:
  "𝒟 (op_obj_cf_comma b 𝔉ArrMap) = b CF 𝔉Arr"
  unfolding op_obj_cf_comma_def
  by 
    (
      cs_concl cs_shallow 
        cs_simp: cat_comma_cs_simps cat_obj_cf_comma_def[symmetric] 
    )

lemmas [cat_comma_cs_simps] = is_functor.op_obj_cf_comma_ArrMap_vdomain

lemma (in is_functor) op_cf_obj_comma_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [[a, 0, f], [a', 0, f'], [g, 0]]" 
    and "b  𝔅Obj" 
    and "ABF  𝔉 CF bArr"
  shows "op_cf_obj_comma 𝔉 bArrMapABF = [[0, a', f'], [0, a, f], [0, g]]"
proof-
  from assms(3) have g: "g : a 𝔄a'"
    and f: "f : 𝔉ObjMapa 𝔅b"
    and f': "f' : 𝔉ObjMapa' 𝔅b"
    and [cat_comma_cs_simps]: "f' A𝔅𝔉ArrMapg = f"
    by (intro cat_cf_obj_comma_ArrD[OF assms(3)[unfolded assms(1)] assms(2)])+
  from assms(2) g f f' show ?thesis
    unfolding assms(1) op_cf_obj_comma_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_comma_cs_simps cat_1_CId_app
          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
      )
qed

lemmas [cat_comma_cs_simps] = is_functor.op_cf_obj_comma_ArrMap_app

lemma (in is_functor) op_obj_cf_comma_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [[0, a, f], [0, a', f'], [0, h]]" 
    and "b  𝔅Obj" 
    and "ABF  b CF 𝔉Arr"
  shows "op_obj_cf_comma b 𝔉ArrMapABF = [[a', 0, f'], [a, 0, f], [h, 0]]"
proof-
  from assms(3) have h: "h : a 𝔄a'"
    and f: "f : b 𝔅𝔉ObjMapa"
    and f': "f' : b 𝔅𝔉ObjMapa'"
    and [cat_comma_cs_simps]: "𝔉ArrMaph A𝔅f = f'"
    by (intro cat_obj_cf_comma_ArrD[OF assms(3)[unfolded assms(1)] assms(2)])+
  from assms(2) h f f' show ?thesis
    unfolding assms(1) op_obj_cf_comma_def
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_comma_cs_simps cat_1_CId_app
          cs_intro: V_cs_intros cat_cs_intros cat_comma_cs_intros cat_1_is_arrI
      )
qed

lemmas [cat_comma_cs_simps] = is_functor.op_obj_cf_comma_ArrMap_app


subsubsection‹
Opposite comma category functors for the comma categories
constructed from a functor and an object are isomorphisms of categories
›

lemma (in is_functor) op_cf_obj_comma_is_iso_functor:
  assumes "b  𝔅Obj"
  shows "op_cf_obj_comma 𝔉 b : op_cat (𝔉 CF b) ↦↦C.isoαb CF (op_cf 𝔉)"
proof-
  from assms have cf_const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
  note cat_obj_cf_comma_def = 
    is_functor.cat_obj_cf_comma_def[
      OF is_functor_op, unfolded cat_op_simps
      ]
  show ?thesis
    by 
      (
        rule op_cf_comma_is_iso_functor
          [
            OF is_functor_axioms cf_const, 
            folded cat_cf_obj_comma_def op_cf_obj_comma_def,
            unfolded cat_op_simps, 
            folded cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_functor) op_cf_obj_comma_is_iso_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
    and "𝔄' = op_cat (𝔉 CF b)"
    and "𝔅' = b CF (op_cf 𝔉)"
  shows "op_cf_obj_comma 𝔉 b : 𝔄' ↦↦C.isoα𝔅'"
  using assms(1) unfolding assms(2,3) by (rule op_cf_obj_comma_is_iso_functor)

lemmas [cat_comma_cs_intros] = is_functor.op_cf_obj_comma_is_iso_functor'

lemma (in is_functor) op_cf_obj_comma_is_functor:
  assumes "b  𝔅Obj"
  shows "op_cf_obj_comma 𝔉 b : op_cat (𝔉 CF b) ↦↦Cαb CF (op_cf 𝔉)"
  by (rule is_iso_functorD(1)[OF op_cf_obj_comma_is_iso_functor[OF assms]])

lemma (in is_functor) op_cf_obj_comma_is_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
    and "𝔄' = op_cat (𝔉 CF b)"
    and "𝔅' = b CF (op_cf 𝔉)"
  shows "op_cf_obj_comma 𝔉 b : 𝔄' ↦↦Cα𝔅'"
  using assms(1) unfolding assms(2,3) by (rule op_cf_obj_comma_is_functor)

lemmas [cat_comma_cs_intros] = is_functor.op_cf_obj_comma_is_functor'

lemma (in is_functor) op_obj_cf_comma_is_iso_functor:
  assumes "b  𝔅Obj"
  shows "op_obj_cf_comma b 𝔉 : op_cat (b CF 𝔉) ↦↦C.isoα(op_cf 𝔉) CF b"
proof-
  from assms have cf_const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
  note cat_cf_obj_comma_def = 
    is_functor.cat_cf_obj_comma_def[
      OF is_functor_op, unfolded cat_op_simps
      ]
  show ?thesis
    by
      (
        rule op_cf_comma_is_iso_functor
          [
            OF cf_const is_functor_axioms,
            folded cat_obj_cf_comma_def op_obj_cf_comma_def,
            unfolded cat_op_simps,
            folded cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) op_obj_cf_comma_is_iso_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
    and "𝔄' = op_cat (b CF 𝔉)"
    and "𝔅' = (op_cf 𝔉) CF b"
  shows "op_obj_cf_comma b 𝔉 : 𝔄' ↦↦C.isoα𝔅'"
  using assms(1) unfolding assms(2,3) by (rule op_obj_cf_comma_is_iso_functor)
  
lemmas [cat_comma_cs_intros] = is_functor.op_obj_cf_comma_is_iso_functor'

lemma (in is_functor) op_obj_cf_comma_is_functor:
  assumes "b  𝔅Obj"
  shows "op_obj_cf_comma b 𝔉 : op_cat (b CF 𝔉) ↦↦Cα(op_cf 𝔉) CF b"
  by (rule is_iso_functorD(1)[OF op_obj_cf_comma_is_iso_functor[OF assms]])

lemma (in is_functor) op_obj_cf_comma_is_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj"
    and "𝔄' = op_cat (b CF 𝔉)"
    and "𝔅' = (op_cf 𝔉) CF b"
  shows "op_obj_cf_comma b 𝔉 : 𝔄' ↦↦Cα𝔅'"
  using assms(1) unfolding assms(2,3) by (rule op_obj_cf_comma_is_functor)



subsection‹
Projections for comma categories constructed from a functor and an object
›


subsubsection‹Definitions and elementary properties›

definition cf_cf_obj_comma_proj :: "V  V  V" ((_ CFO _) [1000, 1000] 999)
  where "𝔉 CFO b  𝔉 CF (cf_const (cat_1 0 0) (𝔉HomCod) b)"

definition cf_obj_cf_comma_proj :: "V  V  V" ((_ OCF _) [1000, 1000] 999)
  where "b OCF 𝔉  (cf_const (cat_1 0 0) (𝔉HomCod) b) CF 𝔉"


text‹Alternative forms of the definitions.›

lemma (in is_functor) cf_cf_obj_comma_proj_def:
  "𝔉 CFO b = 𝔉 CF (cf_const (cat_1 0 0) 𝔅 b)" 
  unfolding cf_cf_obj_comma_proj_def cf_HomCod..

lemma (in is_functor) cf_obj_cf_comma_proj_def: 
  "b OCF 𝔉 = (cf_const (cat_1 0 0) 𝔅 b) CF 𝔉" 
  unfolding cf_obj_cf_comma_proj_def cf_HomCod..


text‹Components.›

lemma (in is_functor) cf_cf_obj_comma_proj_components[cat_comma_cs_simps]: 
  shows "𝔉 CFO bHomDom = 𝔉 CF b"
    and "𝔉 CFO bHomCod = 𝔄"
  unfolding 
    cf_cf_obj_comma_proj_def 
    cf_comma_proj_left_components 
    cat_cf_obj_comma_def[symmetric]
    cat_cs_simps 
  by simp_all

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_components

lemma (in is_functor) cf_obj_cf_comma_proj_components[cat_comma_cs_simps]: 
  shows "b OCF 𝔉HomDom = b CF 𝔉"
    and "b OCF 𝔉HomCod = 𝔄"
  unfolding 
    cf_obj_cf_comma_proj_def 
    cf_comma_proj_right_components 
    cat_obj_cf_comma_def[symmetric]
    cat_cs_simps 
  by simp_all

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_components


subsubsection‹Object map›

lemma cf_cf_obj_comma_proj_ObjMap_vsv[cat_comma_cs_intros]: 
  "vsv (𝔉 CFO bObjMap)"
  unfolding cf_cf_obj_comma_proj_def
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma cf_obj_cf_comma_proj_ObjMap_vsv[cat_comma_cs_intros]: 
  "vsv (b OCF 𝔉ObjMap)"
  unfolding cf_obj_cf_comma_proj_def
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]: 
  "𝒟 (𝔉 CFO bObjMap) = 𝔉 CF bObj"
  unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ObjMap_vdomain
  unfolding 
    cf_cf_obj_comma_proj_def[symmetric] 
    cf_comma_proj_left_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain

lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_vdomain[cat_comma_cs_simps]: 
  "𝒟 (b OCF 𝔉ObjMap) = b CF 𝔉Obj"
  unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ObjMap_vdomain
  unfolding 
    cf_obj_cf_comma_proj_def[symmetric] 
    cf_comma_proj_right_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_vdomain

lemma (in is_functor) cf_cf_obj_comma_proj_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a, b', f]" and "[a, b', f]  𝔉 CF bObj"
  shows "𝔉 CFO bObjMapA = a"
  by 
    (
      rule cf_comma_proj_left_ObjMap_app[
        OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def], 
        folded cf_cf_obj_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_app

lemma (in is_functor) cf_obj_cf_comma_proj_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [b', a, f]" and "[b', a, f]  b CF 𝔉Obj"
  shows "b OCF 𝔉ObjMapA = a"
  by 
    (
      rule cf_comma_proj_right_ObjMap_app[
        OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
        folded cf_obj_cf_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ObjMap_app


subsubsection‹Arrow map›

lemma cf_cf_obj_comma_proj_ArrMap_vsv[cat_comma_cs_intros]: 
  "vsv (𝔉 CFO bArrMap)"
  unfolding cf_cf_obj_comma_proj_def
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma cf_obj_cf_comma_proj_ArrMap_vsv[cat_comma_cs_intros]: 
  "vsv (b OCF 𝔉ArrMap)"
  unfolding cf_obj_cf_comma_proj_def
  by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]: 
  "𝒟 (𝔉 CFO bArrMap) = 𝔉 CF bArr"
  unfolding cf_cf_obj_comma_proj_def cf_comma_proj_left_ArrMap_vdomain
  unfolding 
    cf_cf_obj_comma_proj_def[symmetric] 
    cf_comma_proj_left_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ObjMap_vdomain

lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_vdomain[cat_comma_cs_simps]:
  "𝒟 (b OCF 𝔉ArrMap) = b CF 𝔉Arr"
  unfolding cf_obj_cf_comma_proj_def cf_comma_proj_right_ArrMap_vdomain
  unfolding 
    cf_obj_cf_comma_proj_def[symmetric] 
    cf_comma_proj_right_components[symmetric]
    cat_comma_cs_simps
  by simp

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_vdomain

lemma (in is_functor) cf_cf_obj_comma_proj_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, [g, h]]" 
    and "[A, B, [g, h]]  𝔉 CF bArr"
  shows "𝔉 CFO bArrMapABF = g"
  by 
    (
      rule cf_comma_proj_left_ArrMap_app[
        OF assms(1) assms(2)[unfolded cat_cf_obj_comma_def], 
        folded cf_cf_obj_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_obj_comma_proj_ArrMap_app

lemma (in is_functor) cf_obj_cf_comma_proj_ArrMap_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, [g, h]]" 
    and "[A, B, [g, h]]  b CF 𝔉Arr"
  shows "b OCF 𝔉ArrMapABF = h"
  by 
    (
      rule cf_comma_proj_right_ArrMap_app[
        OF assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
        folded cf_obj_cf_comma_proj_def
        ]
    )

lemmas [cat_comma_cs_simps] = is_functor.cf_obj_cf_comma_proj_ArrMap_app


subsubsection‹Projections for a comma category are functors›

lemma (in is_functor) cf_cf_obj_comma_proj_is_functor:
  assumes "b  𝔅Obj"
  shows "𝔉 CFO b : 𝔉 CF b ↦↦Cα𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_left_is_functor[
          OF is_functor_axioms const,
          folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_functor) cf_cf_obj_comma_proj_is_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" and "𝔄' = 𝔉 CF b"
  shows "𝔉 CFO b : 𝔄' ↦↦Cα𝔄"
  using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_functor)

lemmas [cat_comma_cs_intros] = is_functor.cf_cf_obj_comma_proj_is_functor'

lemma (in is_functor) cf_obj_cf_comma_proj_is_functor:
  assumes "b  𝔅Obj"
  shows "b OCF 𝔉 : b CF 𝔉 ↦↦Cα𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_right_is_functor[
          OF const is_functor_axioms,
          folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_functor) cf_obj_cf_comma_proj_is_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" and "𝔄' = b CF 𝔉"
  shows "b OCF 𝔉 : 𝔄' ↦↦Cα𝔄"
  using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_functor)

lemmas [cat_comma_cs_intros] = is_functor.cf_obj_cf_comma_proj_is_functor'


subsubsection‹
Opposite projections for comma categories constructed from a functor 
and an object
›

lemma (in is_functor) op_cf_cf_obj_comma_proj: 
  assumes "b  𝔅Obj"
  shows "op_cf (𝔉 CFO b) = b OCF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 b"
proof-
  from assms have cf_const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by
      (
        rule op_cf_comma_proj_left
          [
            OF is_functor_axioms cf_const,
            unfolded cat_op_simps,
            folded 
              cf_cf_obj_comma_proj_def
              op_cf_obj_comma_def
              is_functor.cf_obj_cf_comma_proj_def[
                OF is_functor_op, unfolded cat_op_simps
                ]
          ]
      )
qed

lemma (in is_functor) op_cf_obj_cf_comma_proj:
  assumes "b  𝔅Obj"
  shows "op_cf (b OCF 𝔉) = (op_cf 𝔉) CFO b CF op_obj_cf_comma b 𝔉"
proof-
  from assms have cf_const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦Cα𝔅"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule op_cf_comma_proj_right
          [
            OF cf_const is_functor_axioms,
            unfolded cat_op_simps,
            folded
              cf_obj_cf_comma_proj_def
              op_obj_cf_comma_def
              is_functor.cf_cf_obj_comma_proj_def[
                OF is_functor_op, unfolded cat_op_simps
                ]
          ]
      )
qed


subsubsection‹Projections for a tiny comma category›

lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor:
  assumes "b  𝔅Obj"
  shows "𝔉 CFO b : 𝔉 CF b ↦↦C.tmα𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmα𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_left_is_tm_functor[
          OF is_tm_functor_axioms const,
          folded cf_cf_obj_comma_proj_def cat_cf_obj_comma_def
          ]
      )
qed

lemma (in is_tm_functor) cf_cf_obj_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" and "𝔉b = 𝔉 CF b"
  shows "𝔉 CFO b : 𝔉b ↦↦C.tmα𝔄"
  using assms(1) unfolding assms(2) by (rule cf_cf_obj_comma_proj_is_tm_functor)

lemmas [cat_comma_cs_intros] = is_tm_functor.cf_cf_obj_comma_proj_is_tm_functor'

lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor:
  assumes "b  𝔅Obj"
  shows "b OCF 𝔉 : b CF 𝔉 ↦↦C.tmα𝔄"
proof-
  from assms have const: "cf_const (cat_1 0 0) 𝔅 b : cat_1 0 0 ↦↦C.tmα𝔅"
    by (cs_concl cs_intro: V_cs_intros cat_small_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comma_proj_right_is_tm_functor[
          OF const is_tm_functor_axioms,
          folded cf_obj_cf_comma_proj_def cat_obj_cf_comma_def
          ]
      )
qed

lemma (in is_tm_functor) cf_obj_cf_comma_proj_is_tm_functor'[cat_comma_cs_intros]:
  assumes "b  𝔅Obj" and "𝔄' = b CF 𝔉"
  shows "b OCF 𝔉 : 𝔄' ↦↦C.tmα𝔄"
  using assms(1) unfolding assms(2) by (rule cf_obj_cf_comma_proj_is_tm_functor)

lemmas [cat_comma_cs_intros] = is_tm_functor.cf_obj_cf_comma_proj_is_tm_functor'

lemma cf_comp_cf_cf_obj_comma_proj_is_tm_functor[cat_comma_cs_intros]:
  assumes "𝔊 : 𝔄 ↦↦Cα" 
    and "𝔉 : 𝔍 ↦↦C.tmα𝔊 CF c"
    and "c  Obj"
  shows "𝔊 CFO c CF 𝔉 : 𝔍 ↦↦C.tmα𝔄"
proof-
  interpret 𝔊: is_functor α 𝔄  𝔊 by (rule assms(1))
  from assms(3) have cf_const: "cf_const (cat_1 0 0)  c : cat_1 0 0 ↦↦Cα"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comp_cf_comma_proj_left_is_tm_functor
          [
            OF assms(1) _ assms(2)[unfolded cat_cf_obj_comma_def],
            unfolded cat_cs_simps,
            OF cf_const, 
            folded 𝔊.cf_cf_obj_comma_proj_def
          ]
      )
qed

lemma cf_comp_cf_obj_cf_comma_proj_is_tm_functor[cat_comma_cs_intros]:
  assumes " : 𝔅 ↦↦Cα" 
    and "𝔉 : 𝔍 ↦↦C.tmαc CF "
    and "c  Obj"
  shows "c OCF  CF 𝔉 : 𝔍 ↦↦C.tmα𝔅"
proof-
  interpret: is_functor α 𝔅   by (rule assms(1))
  from assms(3) have cf_const: "cf_const (cat_1 0 0)  c : cat_1 0 0 ↦↦Cα"
    by (cs_concl cs_simp: cat_cs_simps cs_intro: V_cs_intros cat_cs_intros)
  show ?thesis
    by 
      (
        rule cf_comp_cf_comma_proj_right_is_tm_functor
          [
            OF _ assms(1) assms(2)[unfolded cat_obj_cf_comma_def], 
            unfolded cat_cs_simps,
            OF cf_const, 
            folded ℌ.cf_obj_cf_comma_proj_def
          ]
      )
qed



subsection‹Comma functors›


subsubsection‹Definition and elementary properties›


text‹See Theorem 1 in Chapter X-3 in cite"mac_lane_categories_2010".›

definition cf_arr_cf_comma :: "V  V  V" 
  ((_ ACF _) [1000, 1000] 999)
  where "g ACF 𝔉 =
    [
      (λA(𝔉HomCodCodg) CF 𝔉Obj. [0, A1, A2 A𝔉HomCodg]),
      (
        λF(𝔉HomCodCodg) CF 𝔉Arr.
          [
            [0, F01, F02 A𝔉HomCodg],
            [0, F11, F12 A𝔉HomCodg],
            F2
          ]
      ),
      (𝔉HomCodCodg) CF 𝔉,
      (𝔉HomCodDomg) CF 𝔉
    ]"

definition cf_cf_arr_comma :: "V  V  V" 
  ((_ CFA _) [1000, 1000] 999)
  where "𝔉 CFA g =
    [
      (λA𝔉 CF (𝔉HomCodDomg)Obj. [A0, 0, g A𝔉HomCodA2]),
      (
        λF𝔉 CF (𝔉HomCodDomg)Arr.
          [
            [F00, 0, g A𝔉HomCodF02],
            [F10, 0, g A𝔉HomCodF12],
            F2
          ]
      ),
      𝔉 CF (𝔉HomCodDomg),
      𝔉 CF (𝔉HomCodCodg)
    ]"


text‹Components.›

lemma cf_arr_cf_comma_components:
  shows "g ACF 𝔉ObjMap =
    (λA(𝔉HomCodCodg) CF 𝔉Obj. [0, A1, A2 A𝔉HomCodg])"
    and "g ACF 𝔉ArrMap =
      (
        λF(𝔉HomCodCodg) CF 𝔉Arr.
          [
            [0, F01, F02 A𝔉HomCodg],
            [0, F11, F12 A𝔉HomCodg],
            F2
          ]
      )"
    and "g ACF 𝔉HomDom = (𝔉HomCodCodg) CF 𝔉"
    and "g ACF 𝔉HomCod = (𝔉HomCodDomg) CF 𝔉"
  unfolding cf_arr_cf_comma_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)

lemma cf_cf_arr_comma_components:
  shows "𝔉 CFA gObjMap =
    (λA𝔉 CF (𝔉HomCodDomg)Obj. [A0, 0, g A𝔉HomCodA2])"
    and "𝔉 CFA gArrMap =
      (
        λF𝔉 CF (𝔉HomCodDomg)Arr.
          [
            [F00, 0, g A𝔉HomCodF02],
            [F10, 0, g A𝔉HomCodF12],
            F2
          ]
      )"
    and "𝔉 CFA gHomDom = 𝔉 CF (𝔉HomCodDomg)"
    and "𝔉 CFA gHomCod = 𝔉 CF (𝔉HomCodCodg)"
  unfolding cf_cf_arr_comma_def dghm_field_simps 
  by (simp_all add: nat_omega_simps)

context is_functor
begin

lemma cf_arr_cf_comma_components':
  assumes "g : c 𝔅c'"
  shows "g ACF 𝔉ObjMap = (λAc' CF 𝔉Obj. [0, A1, A2 A𝔅g])"
    and "g ACF 𝔉ArrMap =
      (
        λFc' CF 𝔉Arr.
          [
            [0, F01, F02 A𝔅g],
            [0, F11, F12 A𝔅g],
            F2
          ]
      )"
    and [cat_comma_cs_simps]: "g ACF 𝔉HomDom = c' CF 𝔉"
    and [cat_comma_cs_simps]: "g ACF 𝔉HomCod = c CF 𝔉"
  using assms
  unfolding cf_arr_cf_comma_components
  by (simp_all add: cat_cs_simps)

lemma cf_cf_arr_comma_components':
  assumes "g : c 𝔅c'"
  shows "𝔉 CFA gObjMap = (λA𝔉 CF cObj. [A0, 0, g A𝔅A2])"
    and "𝔉 CFA gArrMap =
      (
        λF𝔉 CF cArr.
          [
            [F00, 0, g A𝔅F02],
            [F10, 0, g A𝔅F12],
            F2
          ]
      )"
    and [cat_comma_cs_simps]: "𝔉 CFA gHomDom = 𝔉 CF c"
    and [cat_comma_cs_simps]: "𝔉 CFA gHomCod = 𝔉 CF c'"
  using assms
  unfolding cf_cf_arr_comma_components
  by (simp_all add: cat_cs_simps)

end

lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_components'(3,4)
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_components'(3,4)


subsubsection‹Object map›

mk_VLambda cf_arr_cf_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
  |vsv cf_arr_cf_comma_ObjMap_vsv[cat_comma_cs_intros]|

mk_VLambda cf_cf_arr_comma_components(1)[unfolded VLambda_vid_on[symmetric]]
  |vsv cf_cf_arr_comma_ObjMap_vsv[cat_comma_cs_intros]|

context is_functor
begin

context 
  fixes g c c'
  assumes g: "g : c 𝔅c'"
begin

mk_VLambda 
  cf_arr_cf_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
  |vdomain cf_arr_cf_comma_ObjMap_vdomain[cat_comma_cs_simps]|

mk_VLambda
  cf_cf_arr_comma_components'(1)[OF g, unfolded VLambda_vid_on[symmetric]]
  |vdomain cf_cf_arr_comma_ObjMap_vdomain[cat_comma_cs_simps]|

end

end

lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ObjMap_vdomain
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_vdomain

lemma (in is_functor) cf_arr_cf_comma_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a', b', f']" and "A  c' CF 𝔉Obj" and "g : c 𝔅c'"
  shows "g ACF 𝔉ObjMapA = [a', b', f' A𝔅g]"
proof-
  from assms have b': "b'  𝔄Obj"
    and f: "f' : c' 𝔅𝔉ObjMapb'"
    and a'_def: "a' = 0"
    by auto
  from assms(2) show ?thesis
    unfolding cf_arr_cf_comma_components'[OF assms(3)] assms(1)
    by (simp add: nat_omega_simps a'_def)
qed

lemma (in is_functor) cf_cf_arr_comma_ObjMap_app[cat_comma_cs_simps]:
  assumes "A = [a', b', f']" and "A  𝔉 CF cObj" and "g : c 𝔅c'"
  shows "𝔉 CFA gObjMapA = [a', b', g A𝔅f']"
proof-
  from assms have b'_def: "b' = 0"
    and f: "f' : 𝔉ObjMapa' 𝔅c"
    and a': "a'  𝔄Obj"
    by auto
  from assms(2) show ?thesis
    unfolding cf_cf_arr_comma_components'[OF assms(3)] assms(1)
    by (simp add: nat_omega_simps b'_def)
qed

lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ObjMap_app
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ObjMap_app

lemma (in is_functor) cf_arr_cf_comma_ObjMap_vrange: 
  assumes "g : c 𝔅c'"
  shows " (g ACF 𝔉ObjMap)  c CF 𝔉Obj"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold cf_arr_cf_comma_ObjMap_vdomain[OF assms]
  )
  fix A assume "A  c' CF 𝔉Obj"
  with assms is_functor_axioms obtain a f 
    where A_def: "A = [0, a, f]"
      and a: "a  𝔄Obj"
      and f: "f : c' 𝔅𝔉ObjMapa" 
    by auto
  from assms a f show "g ACF 𝔉ObjMapA  c CF 𝔉Obj"
    by 
      (
        cs_concl cs_shallow
          cs_simp: cat_comma_cs_simps A_def
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)

lemma (in is_functor) cf_cf_arr_comma_ObjMap_vrange: 
  assumes "g : c 𝔅c'"
  shows " (𝔉 CFA gObjMap)  𝔉 CF c'Obj"
proof
  (
    rule vsv.vsv_vrange_vsubset, 
    unfold cf_cf_arr_comma_ObjMap_vdomain[OF assms]
  )
  fix A assume "A  𝔉 CF cObj"
  with assms is_functor_axioms obtain a f 
    where A_def: "A = [a, 0, f]"
      and a: "a  𝔄Obj"
      and f: "f : 𝔉ObjMapa 𝔅c" 
    by auto
  from assms a f show "𝔉 CFA gObjMapA  𝔉 CF c'Obj"
    by
      (
        cs_concl cs_shallow
          cs_simp: cat_comma_cs_simps A_def
          cs_intro: cat_cs_intros cat_comma_cs_intros
      )
qed (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)


subsubsection‹Arrow map›

mk_VLambda cf_arr_cf_comma_components(2)
  |vsv cf_arr_cf_comma_ArrMap_vsv[cat_comma_cs_intros]|

mk_VLambda cf_cf_arr_comma_components(2)
  |vsv cf_cf_arr_comma_ArrMap_vsv[cat_comma_cs_intros]|

context is_functor
begin

context 
  fixes g c c'
  assumes g: "g : c 𝔅c'"
begin

mk_VLambda 
  cf_arr_cf_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
  |vdomain cf_arr_cf_comma_ArrMap_vdomain[cat_comma_cs_simps]|

mk_VLambda 
  cf_cf_arr_comma_components'(2)[OF g, unfolded VLambda_vid_on[symmetric]]
  |vdomain cf_cf_arr_comma_ArrMap_vdomain[cat_comma_cs_simps]|

end

end

lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ArrMap_vdomain
lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_vdomain

lemma (in is_functor) cf_arr_cf_comma_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [[a, b, f], [a', b', f'], [h, k]]"
    and "[[a, b, f], [a', b', f'], [h, k]] :
    [a, b, f] c' CF 𝔉[a', b', f']" 
    and "g : c 𝔅c'"
  shows "g ACF 𝔉ArrMapA =
    [[a, b, f A𝔅g], [a', b', f' A𝔅g], [h, k]]"
proof-
  from assms(3) have c': "c'  𝔅Obj" by auto
  from 
    cat_obj_cf_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c'] 
    is_arrD(1)[OF assms(2)] 
  show ?thesis
    unfolding assms(1) cf_arr_cf_comma_components'[OF assms(3)]
    by (simp_all add: nat_omega_simps)
qed

lemmas [cat_comma_cs_simps] = is_functor.cf_arr_cf_comma_ArrMap_app

lemma (in is_functor) cf_cf_arr_comma_ArrMap_app[cat_comma_cs_simps]:
  assumes "A = [[a, b, f], [a', b', f'], [h, k]]"
    and "[[a, b, f], [a', b', f'], [h, k]] :
      [a, b, f] 𝔉 CF c[a', b', f']" 
    and "g : c 𝔅c'"
  shows "𝔉 CFA gArrMapA =
    [[a, b, g A𝔅f], [a', b', g A𝔅f'], [h, k]]"
proof-
  from assms(3) have c: "c  𝔅Obj" by auto
  from 
    cat_cf_obj_comma_is_arrD(1,2)[OF assms(2)[unfolded cat_comma_cs_simps] c] 
    is_arrD(1)[OF assms(2)] 
  show ?thesis
    unfolding assms(1) cf_cf_arr_comma_components'[OF assms(3)]
    by (simp_all add: nat_omega_simps)
qed

lemmas [cat_comma_cs_simps] = is_functor.cf_cf_arr_comma_ArrMap_app


subsubsection‹Comma functors are functors›

lemma (in is_functor) cf_arr_cf_comma_is_functor:
  assumes "g : c 𝔅c'"
  shows "g ACF 𝔉 : c' CF 𝔉 ↦↦Cαc CF 𝔉"
proof(rule is_functorI')
  show "vfsequence (g ACF 𝔉)" unfolding cf_arr_cf_comma_def by simp
  from assms show "category α (c' CF 𝔉)"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms show "category α (c CF 𝔉)"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  show "vcard (g ACF 𝔉) = 4"
    unfolding cf_arr_cf_comma_def by (simp_all add: nat_omega_simps)
  from assms show " (g ACF 𝔉ObjMap)  c CF 𝔉Obj"
    by (intro cf_arr_cf_comma_ObjMap_vrange)
  show "g ACF 𝔉ArrMapF :
    g ACF 𝔉ObjMapA c CF 𝔉g ACF 𝔉ObjMapB"
    if "F : A c' CF 𝔉B" for A B F
  proof-
    from assms that obtain b f b' f' k 
      where F_def: "F = [[0, b, f], [0, b', f'], [0, k]]"
        and A_def: "A = [0, b, f]"
        and B_def: "B = [0, b', f']"
        and k: "k : b 𝔄b'"
        and f: "f : c' 𝔅𝔉ObjMapb"
        and f': "f' : c' 𝔅𝔉ObjMapb'"
        and f'_def: "𝔉ArrMapk A𝔅f = f'"
      by auto
    from assms that k f f' show ?thesis
      unfolding F_def A_def B_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps f'_def[symmetric]
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
  show "g ACF 𝔉ArrMapG Ac' CF 𝔉F =
    g ACF 𝔉ArrMapG Ac CF 𝔉g ACF 𝔉ArrMapF"
    if "G : B c' CF 𝔉C" and "F : A c' CF 𝔉B" for B C G A F
  proof-
    from that(2) assms obtain b f b' f' k 
      where F_def: "F = [[0, b, f], [0, b', f'], [0, k]]"
        and A_def: "A = [0, b, f]"
        and B_def: "B = [0, b', f']"
        and k: "k : b 𝔄b'"
        and f: "f : c' 𝔅𝔉ObjMapb"
        and f': "f' : c' 𝔅𝔉ObjMapb'"
        and f'_def: "𝔉ArrMapk A𝔅f = f'"
      by auto
    with that(1) assms obtain b'' f'' k' 
      where G_def: "G = [[0, b', f'], [0, b'', f''], [0, k']]"
        and C_def: "C = [0, b'', f'']"
        and k': "k' : b' 𝔄b''"
        and f'': "f'' : c' 𝔅𝔉ObjMapb''"
        and f''_def: "𝔉ArrMapk' A𝔅f' = f''"
      by auto (*slow*)
    from assms that k f f' f'' k' show ?thesis
      unfolding F_def G_def A_def B_def C_def 
      by (*slow*)
        (
          cs_concl 
            cs_simp:
              cat_cs_simps cat_comma_cs_simps
              f''_def[symmetric] f'_def[symmetric]
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
  show "g ACF 𝔉ArrMapc' CF 𝔉CIdC = c CF 𝔉CIdg ACF 𝔉ObjMapC"
    if "C  c' CF 𝔉Obj" for C
  proof-
    from that assms obtain a f 
      where C_def: "C = [0, a, f]"
        and a: "a  𝔄Obj" 
        and f: "f : c' 𝔅𝔉ObjMapa"
      by auto
    from a assms f show
      "g ACF 𝔉ArrMapc' CF 𝔉CIdC = c CF 𝔉CIdg ACF 𝔉ObjMapC"
      unfolding C_def 
      by
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
qed
  (
    use assms in
      cs_concl cs_shallow
          cs_simp: cat_comma_cs_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros
  )+

lemma (in is_functor) cf_cf_arr_comma_is_functor:
  assumes "g : c 𝔅c'"
  shows "𝔉 CFA g : 𝔉 CF c ↦↦Cα𝔉 CF c'"
proof(rule is_functorI')
  from assms have c: "c  𝔅Obj" by auto
  show "vfsequence (𝔉 CFA g)" unfolding cf_cf_arr_comma_def by simp
  from assms show "category α (𝔉 CF c')"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms show "category α (𝔉 CF c)"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  show "vcard (𝔉 CFA g) = 4"
    unfolding cf_cf_arr_comma_def by (simp_all add: nat_omega_simps)
  from assms show " (𝔉 CFA gObjMap)  𝔉 CF c'Obj"
    by (intro cf_cf_arr_comma_ObjMap_vrange)
  show "𝔉 CFA gArrMapF :
    𝔉 CFA gObjMapA 𝔉 CF c'𝔉 CFA gObjMapB"
    if "F : A 𝔉 CF cB" for A B F
  proof-
    from assms that obtain a f a' f' h 
      where F_def: "F = [[a, 0, f], [a', 0, f'], [h, 0]]"
        and A_def: "A = [a, 0, f]"
        and B_def: "B = [a', 0, f']"
        and h: "h : a 𝔄a'"
        and f: "f : 𝔉ObjMapa 𝔅c"
        and f': "f' : 𝔉ObjMapa' 𝔅c"
        and f'_def: "f' A𝔅𝔉ArrMaph = f"
      by auto
    from assms that h f f' show ?thesis
      unfolding F_def A_def B_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps f'_def
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
  show "𝔉 CFA gArrMapG A𝔉 CF cF =
    𝔉 CFA gArrMapG A𝔉 CF c'𝔉 CFA gArrMapF"
    if "G : B 𝔉 CF cC" and "F : A 𝔉 CF cB" for B C G A F
  proof-
    from that(2) assms obtain a f a' f' h 
      where F_def: "F = [[a, 0, f], [a', 0, f'], [h, 0]]"
        and A_def: "A = [a, 0, f]"
        and B_def: "B = [a', 0, f']"
        and h: "h : a 𝔄a'"
        and f: "f : 𝔉ObjMapa 𝔅c"
        and f': "f' : 𝔉ObjMapa' 𝔅c"
        and [cat_cs_simps]: "f' A𝔅𝔉ArrMaph = f"
      by auto
    with that(1) assms obtain a'' f'' h' 
      where G_def: "G = [[a', 0, f'], [a'', 0, f''], [h', 0]]"
        and C_def: "C = [a'', 0, f'']"
        and h': "h' : a' 𝔄a''"
        and f'': "f'' : 𝔉ObjMapa'' 𝔅c"
        and [cat_cs_simps]: "f'' A𝔅𝔉ArrMaph' = f'"
      by auto (*slow*)
    note [cat_cs_simps] = category.cat_assoc_helper[
        where=𝔅, where h=f'' and g=𝔉ArrMaph' and q=f'
        ]
    from assms that c h f f' f'' h' show ?thesis
      unfolding F_def G_def A_def B_def C_def
      by
        (
          cs_concl cs_shallow
             cs_simp: cat_cs_simps cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
  show "𝔉 CFA gArrMap𝔉 CF cCIdC = 𝔉 CF c'CId𝔉 CFA gObjMapC"
    if "C  𝔉 CF cObj" for C
  proof-
    from that assms obtain a f 
      where C_def: "C = [a, 0, f]"
        and a: "a  𝔄Obj" 
        and f: "f : 𝔉ObjMapa 𝔅c"
      by auto
    from a c assms f show ?thesis
      unfolding C_def 
      by
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
qed
  (
    use assms in
      cs_concl cs_shallow
          cs_simp: cat_comma_cs_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros
  )+

lemma (in is_functor) cf_arr_cf_comma_is_functor'[cat_comma_cs_intros]:
  assumes "g : c 𝔅c'" and "𝔄' = c' CF 𝔉" and "𝔅' = c CF 𝔉"
  shows "g ACF 𝔉 : 𝔄' ↦↦Cα𝔅'"
  using assms(1) unfolding assms(2,3) by (rule cf_arr_cf_comma_is_functor(1))

lemmas [cat_comma_cs_intros] = is_functor.cf_arr_cf_comma_is_functor'

lemma (in is_functor) cf_cf_arr_comma_is_functor'[cat_comma_cs_intros]:
  assumes "g : c 𝔅c'" and "𝔄' = 𝔉 CF c" and "𝔅' = 𝔉 CF c'"
  shows "𝔉 CFA g : 𝔄' ↦↦Cα𝔅'"
  using assms(1) unfolding assms(2,3) by (rule cf_cf_arr_comma_is_functor(1))

lemmas [cat_comma_cs_intros] = is_functor.cf_cf_arr_comma_is_functor'

lemma (in is_functor) cf_arr_cf_comma_CId:
  assumes "b  𝔅Obj"
  shows "(𝔅CIdb) ACF 𝔉 = cf_id (b CF 𝔉)"
proof(rule cf_eqI)
  from vempty_is_zet assms show "cf_id (b CF 𝔉) : b CF 𝔉 ↦↦Cαb CF 𝔉"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  from vempty_is_zet assms show "(𝔅CIdb) ACF 𝔉 : b CF 𝔉 ↦↦Cαb CF 𝔉"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms have ObjMap_dom_lhs: 
    "𝒟 ((𝔅CIdb) ACF 𝔉ObjMap) = b CF 𝔉Obj"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
  from assms have ObjMap_dom_rhs: 
    "𝒟 (cf_id (b CF 𝔉)ObjMap) = b CF 𝔉Obj"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "(𝔅CIdb) ACF 𝔉ObjMap = cf_id (b CF 𝔉)ObjMap"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix A assume prems: "A  b CF 𝔉Obj"
    with assms obtain a' f' 
      where A_def: "A = [0, a', f']"
        and a': "a'  𝔄Obj" 
        and f': "f' : b 𝔅𝔉ObjMapa'"
      by auto
    from prems assms vempty_is_zet a' f' show 
      "(𝔅CIdb) ACF 𝔉ObjMapA = cf_id (b CF 𝔉)ObjMapA"
      unfolding A_def
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros
        )
  qed (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)+
  from assms have ArrMap_dom_lhs: 
    "𝒟 ((𝔅CIdb) ACF 𝔉ArrMap) = b CF 𝔉Arr"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
  from assms have ArrMap_dom_rhs: 
    "𝒟 (cf_id (b CF 𝔉)ArrMap) = b CF 𝔉Arr"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "(𝔅CIdb) ACF 𝔉ArrMap = cf_id (b CF 𝔉)ArrMap"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix F assume prems: "F  b CF 𝔉Arr"
    then obtain A B where F: "F : A b CF 𝔉B" by (auto dest: is_arrI)
    from assms F obtain b' f' b'' f'' h
      where F_def: "F = [[0, b', f'], [0, b'', f''], [0, h]]"
        and A_def: "A = [0, b', f']"
        and B_def: "B = [0, b'', f'']"
        and h: "h : b' 𝔄b''"
        and f': "f' : b 𝔅𝔉ObjMapb'"
        and f'': "f'' : b 𝔅𝔉ObjMapb''"
        and "𝔉ArrMaph A𝔅f' = f''"
      by auto
    from assms prems F h f' f'' show 
      "(𝔅CIdb) ACF 𝔉ArrMapF = cf_id (b CF 𝔉)ArrMapF"
      unfolding F_def A_def B_def
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
        )
  qed (cs_concl cs_shallow cs_intro: cat_comma_cs_intros cat_cs_intros)+
qed simp_all

lemma (in is_functor) cf_cf_arr_comma_CId:
  assumes "b  𝔅Obj"
  shows "𝔉 CFA (𝔅CIdb) = cf_id (𝔉 CF b)"
proof(rule cf_eqI)
  from vempty_is_zet assms show "cf_id (𝔉 CF b) : 𝔉 CF b ↦↦Cα𝔉 CF b"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  from vempty_is_zet assms show "𝔉 CFA (𝔅CIdb) : 𝔉 CF b ↦↦Cα𝔉 CF b"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms have ObjMap_dom_lhs: 
    "𝒟 (𝔉 CFA (𝔅CIdb)ObjMap) = 𝔉 CF bObj"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
  from assms have ObjMap_dom_rhs:
    "𝒟 (cf_id (𝔉 CF b)ObjMap) = 𝔉 CF bObj"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "𝔉 CFA (𝔅CIdb)ObjMap = cf_id (𝔉 CF b)ObjMap"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    fix A assume prems: "A  𝔉 CF bObj"
    with assms obtain a' f' 
      where A_def: "A = [a', 0, f']"
        and a': "a'  𝔄Obj" 
        and f': "f' : 𝔉ObjMapa' 𝔅b"
      by auto
    from prems assms vempty_is_zet a' f' show 
      "𝔉 CFA (𝔅CIdb)ObjMapA = cf_id (𝔉 CF b)ObjMapA"
      unfolding A_def
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps cs_intro: cat_cs_intros
        )
  qed (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)+
  from assms have ArrMap_dom_lhs: 
    "𝒟 (𝔉 CFA (𝔅CIdb)ArrMap) = 𝔉 CF bArr"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps cs_intro: cat_cs_intros)
  from assms have ArrMap_dom_rhs: 
    "𝒟 (cf_id (𝔉 CF b)ArrMap) = 𝔉 CF bArr"
    by (cs_concl cs_shallow cs_simp: cat_cs_simps cs_intro: cat_cs_intros)
  show "𝔉 CFA (𝔅CIdb)ArrMap = cf_id (𝔉 CF b)ArrMap"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix F assume prems: "F  𝔉 CF bArr"
    then obtain A B where F: "F : A 𝔉 CF bB" by (auto dest: is_arrI)
    from assms F obtain a' f' a'' f'' k
      where F_def: "F = [[a', 0, f'], [a'', 0, f''], [k, 0]]"
        and A_def: "A = [a', 0, f']"
        and B_def: "B = [a'', 0, f'']"
        and k: "k : a' 𝔄a''"
        and f': "f' : 𝔉ObjMapa' 𝔅b"
        and f'': "f'' : 𝔉ObjMapa'' 𝔅b"
        and [cat_cs_simps]: "f'' A𝔅𝔉ArrMapk = f'"
      by auto
    from assms prems F k f' f'' show 
      "𝔉 CFA (𝔅CIdb)ArrMapF = cf_id (𝔉 CF b)ArrMapF"
      unfolding F_def A_def B_def
      by 
        (
          cs_concl cs_shallow
            cs_simp: cat_comma_cs_simps cat_cs_simps cs_intro: cat_cs_intros
        )
  qed
    (
      cs_concl cs_shallow
        cs_simp: cat_cs_simps cs_intro: cat_comma_cs_intros cat_cs_intros
    )+
qed simp_all


subsubsection‹Comma functors and projections›

lemma (in is_functor) 
  cf_cf_comp_cf_obj_cf_comma_proj_cf_arr_cf_comma[cat_comma_cs_simps]: 
  assumes "f : a 𝔅b"
  shows "a OCF 𝔉 CF f ACF 𝔉 = b OCF 𝔉"
proof(rule cf_eqI)
  from assms vempty_is_zet show "b OCF 𝔉 : b CF 𝔉 ↦↦Cα𝔄"
    by (cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms show "a OCF 𝔉 CF f ACF 𝔉 : b CF 𝔉 ↦↦Cα𝔄"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms have ObjMap_dom_lhs:
    "𝒟 ((a OCF 𝔉 CF f ACF 𝔉)ObjMap) = b CF 𝔉Obj"
    by 
      ( 
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  from assms have ObjMap_dom_rhs: "𝒟 (b OCF 𝔉ObjMap) = b CF 𝔉Obj"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
  show "(a OCF 𝔉 CF f ACF 𝔉)ObjMap = b OCF 𝔉ObjMap"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    from assms show "vsv (b OCF 𝔉ObjMap)"
      by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
    fix A assume prems: "A  b CF 𝔉Obj"
    with assms obtain b' f' 
      where A_def: "A = [0, b', f']"
        and b': "b'  𝔄Obj" 
        and f': "f' : b 𝔅𝔉ObjMapb'"
      by auto
    from prems assms b' f' show 
      "(a OCF 𝔉 CF f ACF 𝔉)ObjMapA = b OCF 𝔉ObjMapA"
      unfolding A_def
      by 
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
    (
      use assms vempty_is_zet in
        cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros
    )
  from assms have ArrMap_dom_lhs:
    "𝒟 ((a OCF 𝔉 CF f ACF 𝔉)ObjMap) = b CF 𝔉Obj"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  from assms vempty_is_zet have ArrMap_dom_rhs:
    "𝒟 (b OCF 𝔉ObjMap) = b CF 𝔉Obj"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
  from assms vempty_is_zet have ArrMap_dom_lhs:
    "𝒟 ((a OCF 𝔉 CF f ACF 𝔉)ArrMap) = b CF 𝔉Arr"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  from assms have ArrMap_dom_rhs: "𝒟 (b OCF 𝔉ArrMap) = b CF 𝔉Arr"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
  show "(a OCF 𝔉 CF f ACF 𝔉)ArrMap = b OCF 𝔉ArrMap"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix F assume "F  b CF 𝔉Arr"
    then obtain A B where F: "F : A b CF 𝔉B"
      by (auto dest: is_arrI)
    with assms obtain b' f' b'' f'' h
      where F_def: "F = [[0, b', f'], [0, b'', f''], [0, h]]"
        and A_def: "A = [0, b', f']"
        and B_def: "B = [0, b'', f'']"
        and h: "h : b' 𝔄b''"
        and f': "f' : b 𝔅𝔉ObjMapb'"
        and f'': "f'' : b 𝔅𝔉ObjMapb''"
        and f''_def: "𝔉ArrMaph A𝔅f' = f''"
      by auto
    from vempty_is_zet h assms f' f'' F show
      "(a OCF 𝔉 CF f ACF 𝔉)ArrMapF = b OCF 𝔉ArrMapF"
      unfolding F_def A_def B_def 
      by (*slow*)
        (
          cs_concl 
            cs_simp: cat_cs_simps cat_comma_cs_simps f''_def[symmetric]
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+
  qed
    (
      use assms vempty_is_zet in
        cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros
    )
qed simp_all

lemma (in is_functor) 
  cf_cf_comp_cf_cf_obj_comma_proj_cf_cf_arr_comma[cat_comma_cs_simps]: 
  assumes "f : a 𝔅b"
  shows "𝔉 CFO b CF 𝔉 CFA f = 𝔉 CFO a"
proof(rule cf_eqI)
  from assms vempty_is_zet show "𝔉 CFO a : 𝔉 CF a ↦↦Cα𝔄"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms show "𝔉 CFO b CF 𝔉 CFA f : 𝔉 CF a ↦↦Cα𝔄"
    by (cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros)
  from assms have ObjMap_dom_lhs:
    "𝒟 ((𝔉 CFO b CF 𝔉 CFA f)ObjMap) = 𝔉 CF aObj"
    by 
      ( 
        cs_concl cs_shallow 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  from assms have ObjMap_dom_rhs: "𝒟 (𝔉 CFO aObjMap) = 𝔉 CF aObj"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
  show "(𝔉 CFO b CF 𝔉 CFA f)ObjMap = 𝔉 CFO aObjMap"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs)
    from assms show "vsv (𝔉 CFO aObjMap)"
      by (cs_concl cs_shallow cs_intro: cat_comma_cs_intros)
    fix A assume prems: "A  𝔉 CF aObj"
    with assms obtain a' f' 
      where A_def: "A = [a', 0, f']"
        and b': "a'  𝔄Obj"
        and f': "f' : 𝔉ObjMapa' 𝔅a"
      by auto
    from prems assms b' f' show
      "(𝔉 CFO b CF 𝔉 CFA f)ObjMapA = 𝔉 CFO aObjMapA"
      unfolding A_def
      by
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps 
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )
  qed
    (
      use assms vempty_is_zet in
        cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros
    )
  from assms vempty_is_zet have ArrMap_dom_lhs:
    "𝒟 ((𝔉 CFO b CF 𝔉 CFA f)ArrMap) = 𝔉 CF aArr"
    by
      (
        cs_concl cs_shallow
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  from assms have ArrMap_dom_rhs: "𝒟 (𝔉 CFO aArrMap) = 𝔉 CF aArr"
    by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
  show "(𝔉 CFO b CF 𝔉 CFA f)ArrMap = 𝔉 CFO aArrMap"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs)
    fix F assume "F  𝔉 CF aArr"
    then obtain A B where F: "F : A 𝔉 CF aB" by (auto dest: is_arrI)
    with assms obtain a' f' a'' f'' k
      where F_def: "F = [[a', 0, f'], [a'', 0, f''], [k, 0]]"
        and A_def: "A = [a', 0, f']"
        and B_def: "B = [a'', 0, f'']"
        and k: "k : a' 𝔄a''"
        and f': "f' : 𝔉ObjMapa' 𝔅a"
        and f'': "f'' : 𝔉ObjMapa'' 𝔅a"
        and f'_def: "f'' A𝔅𝔉ArrMapk = f'"
      by auto
    from vempty_is_zet k assms f' f'' F show
      "(𝔉 CFO b CF 𝔉 CFA f)ArrMapF = 𝔉 CFO aArrMapF"
      unfolding F_def A_def B_def 
      by
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps f'_def
            cs_intro: cat_cs_intros cat_comma_cs_intros
        )+
  qed
    (
      use assms vempty_is_zet in
        cs_concl cs_shallow cs_intro: cat_cs_intros cat_comma_cs_intros
    )
qed simp_all


subsubsection‹Opposite comma functors›

lemma (in is_functor) cf_op_cf_obj_comma_cf_arr_cf_comma:
  assumes "g : c 𝔅c'"
  shows 
    "op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g) =
      g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c"
proof(rule cf_eqI)
  from assms interpret 𝔉c: category α 𝔉 CF c
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cs_intro: cat_cs_intros cat_comma_cs_intros
      )
  from assms have c: "c  𝔅Obj" by auto
  from assms show "op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g) :
    op_cat (𝔉 CF c) ↦↦Cαc' CF (op_cf 𝔉)"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )
  then have ObjMap_dom_lhs:
    "𝒟 ((op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g))ObjMap) =
      (op_cat (𝔉 CF c))Obj"
    and ArrMap_dom_lhs:
    "𝒟 ((op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g))ArrMap) =
      (op_cat (𝔉 CF c))Arr"
    by (cs_concl cs_simp: cat_cs_simps)+
  from assms show 
    "g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c :
      op_cat (𝔉 CF c) ↦↦Cαc' CF (op_cf 𝔉)"
    by
      (
        cs_concl 
          cs_simp: cat_cs_simps cat_op_simps
          cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
      )
  then have ObjMap_dom_rhs:
    "𝒟 ((g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c)ObjMap) =
      (op_cat (𝔉 CF c))Obj"
    and ArrMap_dom_rhs:
    "𝒟 ((g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c)ArrMap) =
      (op_cat (𝔉 CF c))Arr"
    by (cs_concl cs_simp: cat_cs_simps)+
  show
    "(op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g))ObjMap =
      (g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c)ObjMap"
  proof(rule vsv_eqI, unfold ObjMap_dom_lhs ObjMap_dom_rhs cat_op_simps)
    fix A assume "A  𝔉 CF cObj"
    with assms obtain a f
      where A_def: "A = [a, 0, f]" 
        and a: "a  𝔄Obj" 
        and f: "f : 𝔉ObjMapa 𝔅c"
      by auto
    from assms a f show 
      "(op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g))ObjMapA =
        (g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c)ObjMapA"
      unfolding A_def 
      by
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
        )
  qed 
    (
      use assms in 
        cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
    )+
  show 
    "(op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g))ArrMap =
      (g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c)ArrMap"
  proof(rule vsv_eqI, unfold ArrMap_dom_lhs ArrMap_dom_rhs cat_op_simps)
    fix F assume "F  𝔉 CF cArr"
    then obtain A B where F: "F : A 𝔉 CF cB" by auto
    with assms c obtain a f a' f' h
      where F_def: "F = [[a, 0, f], [a', 0, f'], [h, 0]]"
        and A_def: "A = [a, 0, f]"
        and B_def: "B = [a', 0, f']"
        and h: "h : a 𝔄a'"
        and f: "f : 𝔉ObjMapa 𝔅c"
        and f': "f' : 𝔉ObjMapa' 𝔅c"
        and [cat_comma_cs_simps]: "f' A𝔅𝔉ArrMaph = f"
      by auto
    from F assms h f f' c show 
      "(op_cf_obj_comma 𝔉 c' CF op_cf (𝔉 CFA g))ArrMapF =
        (g ACF (op_cf 𝔉) CF op_cf_obj_comma 𝔉 c)ArrMapF"
      unfolding F_def A_def B_def
      by
        (
          cs_concl cs_shallow
            cs_simp: cat_cs_simps cat_comma_cs_simps cat_op_simps
            cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
        )
  qed
    (
      use assms in
        cs_concl cs_intro: cat_cs_intros cat_comma_cs_intros cat_op_intros
    )+
qed simp_all

text‹\newpage›

end