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 ∈∘ 𝔊⦇HomDom⦈⦇Obj⦈ ∧
        b ∈∘ ℌ⦇HomDom⦈⦇Obj⦈ ∧
        f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘𝔊⦇HomCod⦈⇙ ℌ⦇ObjMap⦈⦇b⦈
    }"

lemma small_cat_comma_Obj[simp]: 
  "small
    {
      [a, b, f]∘ | a b f.
        a ∈∘ 𝔄⦇Obj⦈ ∧ b ∈∘ 𝔅⦇Obj⦈ ∧ f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈
    }"
  (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 : A⦇0⦈ ↦⇘𝔊⦇HomDom⦈⇙ B⦇0⦈ ∧
        h : A⦇1ℕ⦈ ↦⇘ℌ⦇HomDom⦈⇙ B⦇1ℕ⦈ ∧
        B⦇2ℕ⦈ ∘A⇘𝔊⦇HomCod⦈⇙ 𝔊⦇ArrMap⦈⦇g⦈ =
         ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘𝔊⦇HomCod⦈⇙ A⦇2ℕ⦈
    }"

lemma small_cat_comma_Hom[simp]: "small
  {
    [A, B, [g, h]∘]∘ | g h.
      A ∈∘ cat_comma_Obj 𝔊 ℌ ∧
      B ∈∘ cat_comma_Obj 𝔊 ℌ ∧
      g : A⦇0⦈ ↦⇘𝔄⇙ B⦇0⦈ ∧
      h : A⦇1ℕ⦈ ↦⇘𝔅⇙ B⦇1ℕ⦈ ∧
      B⦇2ℕ⦈ ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ A⦇2ℕ⦈
  }"
  (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 𝔊 ℌ ≡
    (
      ⋃∘A∈∘cat_comma_Obj 𝔊 ℌ. ⋃∘B∈∘cat_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" (‹(_ CF↓CF _)› [1000, 1000] 999)
  where "𝔊 CF↓CF ℌ =
    [
      cat_comma_Obj 𝔊 ℌ,
      cat_comma_Arr 𝔊 ℌ,
      (λF∈∘cat_comma_Arr 𝔊 ℌ. F⦇0⦈),
      (λF∈∘cat_comma_Arr 𝔊 ℌ. F⦇1ℕ⦈),
      (
        λGF∈∘cat_comma_composable 𝔊 ℌ.
          [
            GF⦇1ℕ⦈⦇0⦈,
            GF⦇0⦈⦇1ℕ⦈,
            [
              GF⦇0⦈⦇2ℕ⦈⦇0⦈ ∘A⇘𝔊⦇HomDom⦈⇙ GF⦇1ℕ⦈⦇2ℕ⦈⦇0⦈,
              GF⦇0⦈⦇2ℕ⦈⦇1ℕ⦈ ∘A⇘ℌ⦇HomDom⦈⇙ GF⦇1ℕ⦈⦇2ℕ⦈⦇1ℕ⦈
            ]∘
          ]∘
      ),
      (
        λA∈∘cat_comma_Obj 𝔊 ℌ.
          [A, A, [𝔊⦇HomDom⦈⦇CId⦈⦇A⦇0⦈⦈, ℌ⦇HomDom⦈⦇CId⦈⦇A⦇1ℕ⦈⦈]∘]∘
      )
    ]∘"


text‹Components.›

lemma cat_comma_components:
  shows "𝔊 CF↓CF ℌ⦇Obj⦈ = cat_comma_Obj 𝔊 ℌ"
    and "𝔊 CF↓CF ℌ⦇Arr⦈ = cat_comma_Arr 𝔊 ℌ"
    and "𝔊 CF↓CF ℌ⦇Dom⦈ = (λF∈∘cat_comma_Arr 𝔊 ℌ. F⦇0⦈)"
    and "𝔊 CF↓CF ℌ⦇Cod⦈ = (λF∈∘cat_comma_Arr 𝔊 ℌ. F⦇1ℕ⦈)"
    and "𝔊 CF↓CF ℌ⦇Comp⦈ =
      (
        λGF∈∘cat_comma_composable 𝔊 ℌ.
          [
            GF⦇1ℕ⦈⦇0⦈,
            GF⦇0⦈⦇1ℕ⦈,
            [
              GF⦇0⦈⦇2ℕ⦈⦇0⦈ ∘A⇘𝔊⦇HomDom⦈⇙ GF⦇1ℕ⦈⦇2ℕ⦈⦇0⦈,
              GF⦇0⦈⦇2ℕ⦈⦇1ℕ⦈ ∘A⇘ℌ⦇HomDom⦈⇙ GF⦇1ℕ⦈⦇2ℕ⦈⦇1ℕ⦈
            ]∘
          ]∘
      )"
    and "𝔊 CF↓CF ℌ⦇CId⦈ =
      (
        λA∈∘cat_comma_Obj 𝔊 ℌ.
          [A, A, [𝔊⦇HomDom⦈⦇CId⦈⦇A⦇0⦈⦈, ℌ⦇HomDom⦈⦇CId⦈⦇A⦇1ℕ⦈⦈]∘]∘
      )"
  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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈
    }"
  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 : A⦇0⦈ ↦⇘𝔄⇙ B⦇0⦈ ∧
        h : A⦇1ℕ⦈ ↦⇘𝔅⇙ B⦇1ℕ⦈ ∧
        B⦇2ℕ⦈ ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ A⦇2ℕ⦈
    }"
  unfolding cat_comma_Hom_def cat_cs_simps by simp

lemma cat_comma_components':
  shows "𝔊 CF↓CF ℌ⦇Obj⦈ = cat_comma_Obj 𝔊 ℌ"
    and "𝔊 CF↓CF ℌ⦇Arr⦈ = cat_comma_Arr 𝔊 ℌ"
    and "𝔊 CF↓CF ℌ⦇Dom⦈ = (λF∈∘cat_comma_Arr 𝔊 ℌ. F⦇0⦈)"
    and "𝔊 CF↓CF ℌ⦇Cod⦈ = (λF∈∘cat_comma_Arr 𝔊 ℌ. F⦇1ℕ⦈)"
    and "𝔊 CF↓CF ℌ⦇Comp⦈ =
      (
        λGF∈∘cat_comma_composable 𝔊 ℌ.
          [
            GF⦇1ℕ⦈⦇0⦈,
            GF⦇0⦈⦇1ℕ⦈,
            [
              GF⦇0⦈⦇2ℕ⦈⦇0⦈ ∘A⇘𝔄⇙ GF⦇1ℕ⦈⦇2ℕ⦈⦇0⦈,
              GF⦇0⦈⦇2ℕ⦈⦇1ℕ⦈ ∘A⇘𝔅⇙ GF⦇1ℕ⦈⦇2ℕ⦈⦇1ℕ⦈
            ]∘
          ]∘
      )"
    and "𝔊 CF↓CF ℌ⦇CId⦈ =
      (λA∈∘cat_comma_Obj 𝔊 ℌ. [A, A, [𝔄⦇CId⦈⦇A⦇0⦈⦈, 𝔅⦇CId⦈⦇A⦇1ℕ⦈⦈]∘]∘)"
  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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
  shows "A ∈∘ 𝔊 CF↓CF ℌ⦇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]∘ ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    and "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "a ∈∘ 𝔄⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈" 
    and "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
  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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    and "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
  obtains a b f where "A = [a, b, f]∘"
    and "a ∈∘ 𝔄⦇Obj⦈" 
    and "b ∈∘ 𝔅⦇Obj⦈" 
    and "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
  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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
    and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
    and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
  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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
  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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
    and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
    and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
  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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    and "B ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
  shows "F ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
  using assms 
  unfolding cat_comma_components cat_comma_Arr_def 
  by (intro vifunionI)

lemma cat_comma_ArrE[elim]:
  assumes "F ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
  obtains A B 
    where "F ∈∘ cat_comma_Hom 𝔊 ℌ A B"
      and "A ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      and "B ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
  using assms unfolding cat_comma_components cat_comma_Arr_def by auto

lemma cat_comma_ArrD[dest]: 
  assumes "[A, B, F]∘ ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
    and "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "[A, B, F]∘ ∈∘ cat_comma_Hom 𝔊 ℌ A B"
    and "A ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    and "B ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
proof-
  from assms obtain C D 
    where "[A, B, F]∘ ∈∘ cat_comma_Hom 𝔊 ℌ C D"
      and "C ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      and "D ∈∘ 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    and "B ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    by auto
qed


subsubsection‹Domain›

lemma cat_comma_Dom_vsv[cat_comma_cs_intros]: "vsv (𝔊 CF↓CF ℌ⦇Dom⦈)"
  unfolding cat_comma_components by simp

lemma cat_comma_Dom_vdomain[cat_comma_cs_simps]:
  "𝒟∘ (𝔊 CF↓CF ℌ⦇Dom⦈) = 𝔊 CF↓CF ℌ⦇Arr⦈"
  unfolding cat_comma_components by simp

lemma cat_comma_Dom_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]∘" and "ABF ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
  shows "𝔊 CF↓CF ℌ⦇Dom⦈⦇ABF⦈ = A"
  using assms(2) unfolding assms(1) cat_comma_components by simp

lemma cat_comma_Dom_vrange:
  assumes "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "ℛ∘ (𝔊 CF↓CF ℌ⦇Dom⦈) ⊆∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset)
  fix ABF assume "ABF ∈∘ 𝒟∘ (𝔊 CF↓CF ℌ⦇Dom⦈)"
  then have "ABF ∈∘ 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      and B: "B ∈∘ 𝔊 CF↓CF ℌ⦇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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
    by (elim cat_comma_HomE[OF _ assms(1,2)])
  from ABF this A B show "𝔊 CF↓CF ℌ⦇Dom⦈⦇ABF⦈ ∈∘ 𝔊 CF↓CF ℌ⦇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 (𝔊 CF↓CF ℌ⦇Cod⦈)"
  unfolding cat_comma_components by simp

lemma cat_comma_Cod_vdomain[cat_comma_cs_simps]:
  "𝒟∘ (𝔊 CF↓CF ℌ⦇Cod⦈) = 𝔊 CF↓CF ℌ⦇Arr⦈"
  unfolding cat_comma_components by simp

lemma cat_comma_Cod_app[cat_comma_cs_simps]:
  assumes "ABF = [A, B, F]∘" and "ABF ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
  shows "𝔊 CF↓CF ℌ⦇Cod⦈⦇ABF⦈ = 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 "ℛ∘ (𝔊 CF↓CF ℌ⦇Cod⦈) ⊆∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
proof(rule vsv.vsv_vrange_vsubset)
  fix ABF assume "ABF ∈∘ 𝒟∘ (𝔊 CF↓CF ℌ⦇Cod⦈)"
  then have "ABF ∈∘ 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      and B: "B ∈∘ 𝔊 CF↓CF ℌ⦇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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
    by (elim cat_comma_HomE[OF _ assms(1,2)])
  from F this A B show "𝔊 CF↓CF ℌ⦇Cod⦈⦇ABF⦈ ∈∘ 𝔊 CF↓CF ℌ⦇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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
    and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
    and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
  shows "ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ 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 ∈∘ 𝔊 CF↓CF ℌ⦇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 "𝔊 CF↓CF ℌ⦇Dom⦈⦇ABF⦈ = A" "𝔊 CF↓CF ℌ⦇Cod⦈⦇ABF⦈ = 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]∘ ↦⇘𝔊 CF↓CF ℌ⇙ [a', b', f']∘"
    and "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ"
    and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "g : a ↦⇘𝔄⇙ a'"
    and "h : b ↦⇘𝔅⇙ b'"
    and "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
    and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
    and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
    and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
    and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
    by (intro cat_comma_HomD[OF F_cat_comma_ArrD(1) assms(2,3)])+    
qed

lemma cat_comma_is_arrE[elim]:
  assumes "ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ 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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈" 
      and "D ∈∘ 𝔊 CF↓CF ℌ⦇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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
     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 ↦⇘𝔊 CF↓CF ℌ⇙ C"
    and "ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ 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 ↦⇘𝔊 CF↓CF ℌ⇙ C"
      and "ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ 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]∘ ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
      and ABF: "[A, B, F]∘ ∈∘ 𝔊 CF↓CF ℌ⦇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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and f': "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and [cat_comma_cs_simps]: 
        "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
    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'' : 𝔊⦇ObjMap⦈⦇a''⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b''⦈"
      and [cat_comma_cs_simps]: 
        "f'' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g'⦈ = ℌ⦇ArrMap⦈⦇h'⦈ ∘A⇘ℭ⇙ f'"
    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 ↦⇘𝔊 CF↓CF ℌ⇙ 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 ↦⇘𝔊 CF↓CF ℌ⇙ 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 (𝔊 CF↓CF ℌ⦇Comp⦈)"
  unfolding cat_comma_components by auto

lemma cat_comma_Comp_vdomain[cat_comma_cs_simps]: 
  "𝒟∘ (𝔊 CF↓CF ℌ⦇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 ↦⇘𝔊 CF↓CF ℌ⇙ C" 
    and "F : A ↦⇘𝔊 CF↓CF ℌ⇙ B"
  shows "G ∘A⇘𝔊 CF↓CF ℌ⇙ 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 ↦⇘𝔊 CF↓CF ℌ⇙ C" 
    and "ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ B"
  shows "BCG ∘A⇘𝔊 CF↓CF ℌ⇙ ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ 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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      and f': "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
      and [symmetric, cat_cs_simps]: 
        "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
    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'' : 𝔊⦇ObjMap⦈⦇a''⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b''⦈"
      and [cat_cs_simps]: "f'' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g'⦈ = ℌ⦇ArrMap⦈⦇h'⦈ ∘A⇘ℭ⇙ f'"
    by auto (*slow*)
  from g' have 𝔊g': "𝔊⦇ArrMap⦈⦇g'⦈ : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ 𝔊⦇ObjMap⦈⦇a''⦈"
    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=‹𝔊⦇ArrMap⦈⦇g'⦈› and q=‹ℌ⦇ArrMap⦈⦇h'⦈ ∘A⇘ℭ⇙ f'›
      ]
    category.cat_assoc_helper[
      where ℭ=ℭ and h=f and g=‹ℌ⦇ArrMap⦈⦇h⦈› and q=‹f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈›
      ]
  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 (𝔊 CF↓CF ℌ⦇CId⦈)"
  unfolding cat_comma_components by simp

lemma cat_comma_CId_vdomain[cat_comma_cs_simps]:
  assumes "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
  shows "𝒟∘ (𝔊 CF↓CF ℌ⦇CId⦈) = 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
  shows "𝔊 CF↓CF ℌ⦇CId⦈⦇A⦈ = [A, A, [𝔄⦇CId⦈⦇a⦈, 𝔅⦇CId⦈⦇b⦈]∘]∘"
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


subsubsection‹‹Hom›-set›

lemma cat_comma_Hom:
  assumes "𝔊 : 𝔄 ↦↦C⇘α⇙ ℭ" 
    and "ℌ : 𝔅 ↦↦C⇘α⇙ ℭ"
    and "A ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    and "B ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
  shows "Hom (𝔊 CF↓CF ℌ) A B = cat_comma_Hom 𝔊 ℌ A B"
proof(intro vsubset_antisym vsubsetI, unfold in_Hom_iff)
  fix ABF assume "ABF : A ↦⇘𝔊 CF↓CF ℌ⇙ 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 ↦⇘𝔊 CF↓CF ℌ⇙ 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 α (𝔊 CF↓CF ℌ)"
proof-

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

  show ?thesis
  proof(rule categoryI')

    show "vfsequence (𝔊 CF↓CF ℌ)" unfolding cat_comma_def by auto
    show "vcard (𝔊 CF↓CF ℌ) = 6ℕ"
      unfolding cat_comma_def by (simp add: nat_omega_simps)
    show "ℛ∘ (𝔊 CF↓CF ℌ⦇Dom⦈) ⊆∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      by (rule cat_comma_Dom_vrange[OF assms])
    show "ℛ∘ (𝔊 CF↓CF ℌ⦇Cod⦈) ⊆∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      by (rule cat_comma_Cod_vrange[OF assms])
    show "(GF ∈∘ 𝒟∘ (𝔊 CF↓CF ℌ⦇Comp⦈)) ⟷
      (∃g f b c a. GF = [g, f]∘ ∧ g : b ↦⇘𝔊 CF↓CF ℌ⇙ c ∧ f : a ↦⇘𝔊 CF↓CF ℌ⇙ 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' ↦⇘𝔊 CF↓CF ℌ⇙ a''b''f''"
          and "F : abf ↦⇘𝔊 CF↓CF ℌ⇙ a'b'f'"
        by auto
      with assms show "∃g f b c a.
        GF = [g, f]∘ ∧ g : b ↦⇘𝔊 CF↓CF ℌ⇙ c ∧ f : a ↦⇘𝔊 CF↓CF ℌ⇙ b"
        by auto
    qed (use assms in ‹cs_concl cs_shallow cs_intro: cat_comma_composableI›)
    from assms show "𝒟∘ (𝔊 CF↓CF ℌ⦇CId⦈) = 𝔊 CF↓CF ℌ⦇Obj⦈"
      by (cs_concl cs_shallow cs_simp: cat_comma_cs_simps)
    from assms show "G ∘A⇘𝔊 CF↓CF ℌ⇙ F : A ↦⇘𝔊 CF↓CF ℌ⇙ C"
      if "G : B ↦⇘𝔊 CF↓CF ℌ⇙ C" and "F : A ↦⇘𝔊 CF↓CF ℌ⇙ 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⇘𝔊 CF↓CF ℌ⇙ G ∘A⇘𝔊 CF↓CF ℌ⇙ F =
        H ∘A⇘𝔊 CF↓CF ℌ⇙ (G ∘A⇘𝔊 CF↓CF ℌ⇙ F)"
      if "H : C ↦⇘𝔊 CF↓CF ℌ⇙ D"
        and "G : B ↦⇘𝔊 CF↓CF ℌ⇙ C"
        and "F : A ↦⇘𝔊 CF↓CF ℌ⇙ 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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
          and f': "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
          and [cat_cs_simps]: "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
        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'' : 𝔊⦇ObjMap⦈⦇a''⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b''⦈"
          and [cat_cs_simps]: 
            "f'' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g'⦈ = ℌ⦇ArrMap⦈⦇h'⦈ ∘A⇘ℭ⇙ f'"
        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''' : 𝔊⦇ObjMap⦈⦇a'''⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'''⦈"
          and [cat_cs_simps]: 
            "f''' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g''⦈ = ℌ⦇ArrMap⦈⦇h''⦈ ∘A⇘ℭ⇙ f''"
        by auto (*slow*)      
      note [cat_cs_simps] =
        category.cat_assoc_helper[
          where ℭ=ℭ
            and h=f''
            and g=‹𝔊⦇ArrMap⦈⦇g'⦈›
            and q=‹ℌ⦇ArrMap⦈⦇h'⦈ ∘A⇘ℭ⇙ f'›
          ]
        category.cat_assoc_helper[
          where ℭ=ℭ
            and h=f''
            and g=‹𝔊⦇ArrMap⦈⦇g'⦈›
            and q=‹ℌ⦇ArrMap⦈⦇h'⦈ ∘A⇘ℭ⇙ f'›
          ]
        category.cat_assoc_helper[
          where ℭ=ℭ 
            and h=f''' 
            and g=‹𝔊⦇ArrMap⦈⦇g''⦈› 
            and q=‹ℌ⦇ArrMap⦈⦇h''⦈ ∘A⇘ℭ⇙ f''›
          ]
      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 "𝔊 CF↓CF ℌ⦇CId⦈⦇A⦈ : A ↦⇘𝔊 CF↓CF ℌ⇙ A"
      if "A ∈∘ 𝔊 CF↓CF ℌ⦇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 "𝔊 CF↓CF ℌ⦇CId⦈⦇B⦈ ∘A⇘𝔊 CF↓CF ℌ⇙ F = F"
      if "F : A ↦⇘𝔊 CF↓CF ℌ⇙ 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⇘𝔊 CF↓CF ℌ⇙ 𝔊 CF↓CF ℌ⦇CId⦈⦇B⦈ = F"
      if "F : B ↦⇘𝔊 CF↓CF ℌ⇙ 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 "𝔊 CF↓CF ℌ⦇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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      from prems(2-4) show "F ∈∘ Vset α"
        unfolding prems(1) by (cs_concl cs_intro: cat_cs_intros V_cs_intros) 
    qed

    show "(⋃∘a∈∘A. ⋃∘b∈∘B. Hom (𝔊 CF↓CF ℌ) a b) ∈∘ Vset α"
      if "A ⊆∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
        and "B ⊆∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
        and "A ∈∘ Vset α"
        and "B ∈∘ Vset α"
      for A B
    proof-

      define A0 where "A0 = ℛ∘ (λF∈∘A. F⦇0⦈)"
      define A1 where "A1 = ℛ∘ (λF∈∘A. F⦇1ℕ⦈)"
      define B0 where "B0 = ℛ∘ (λF∈∘B. F⦇0⦈)"
      define B1 where "B1 = ℛ∘ (λF∈∘B. F⦇1ℕ⦈)"

      define A0B0 where "A0B0 = (⋃∘a∈∘A0. ⋃∘b∈∘B0. Hom 𝔄 a b)"
      define A1B1 where "A1B1 = (⋃∘a∈∘A1. ⋃∘b∈∘B1. 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 ∈∘ 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇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 = F⦇0⦈" and "F ∈∘ 𝔊 CF↓CF ℌ⦇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 = F⦇0⦈" and "F ∈∘ 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇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 = F⦇1ℕ⦈" and "F ∈∘ 𝔊 CF↓CF ℌ⦇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 = F⦇1ℕ⦈" and "F ∈∘ 𝔊 CF↓CF ℌ⦇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 
        "(⋃∘a∈∘A. ⋃∘b∈∘B.
          Hom (𝔊 CF↓CF ℌ) 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 ↦⇘𝔊 CF↓CF ℌ⇙ 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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
            and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
            and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
          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 ∈∘ ℛ∘ (λF∈∘A. F⦇0⦈)"
            by (intro vsv.vsv_vimageI2'[where a=abf]) (simp_all add: abf_def)
          from prems(2) show "a' ∈∘ ℛ∘ (λF∈∘B. F⦇0⦈)"
            by (intro vsv.vsv_vimageI2'[where a=a'b'f']) 
              (simp_all add: a'b'f'_def)
          from prems(1) show "b ∈∘ ℛ∘ (λF∈∘A. F⦇1ℕ⦈)"
            by (intro vsv.vsv_vimageI2'[where a=abf]) 
              (simp_all add: nat_omega_simps abf_def)
          from prems(2) show "b' ∈∘ ℛ∘ (λF∈∘B. F⦇1ℕ⦈)"
            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 "F⦇i⦈ ∈∘ 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 "(⋃∘a∈∘A. ⋃∘b∈∘B. Hom (𝔊 CF↓CF ℌ) 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 α (𝔊 CF↓CF ℌ)"
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 α ‹𝔊 CF↓CF ℌ›
    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 "𝔊 CF↓CF ℌ⦇Obj⦈ ⊆∘ (∏∘i∈∘ set {0, 1ℕ, 2ℕ}. Q i)"
    proof(intro vsubsetI)
      fix A assume "A ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
      then obtain a b f
        where A_def: "A = [a, b, f]∘"
          and a: "a ∈∘ 𝔄⦇Obj⦈"
          and b: "b ∈∘ 𝔅⦇Obj⦈"
          and f: "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
        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 "A⦇i⦈ ∈∘ 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]: "𝔊 CF↓CF ℌ⦇Obj⦈ ∈∘ Vset α" by auto 
    define Q where
      "Q i =
        (
          if i = 0
          then 𝔊 CF↓CF ℌ⦇Obj⦈
          else
            if i = 1ℕ
            then 𝔊 CF↓CF ℌ⦇Obj⦈
            else 𝔄⦇Arr⦈ ×∙ 𝔅⦇Arr⦈
        )" 
    for i
    have "𝔊 CF↓CF ℌ⦇Arr⦈ ⊆∘ (∏∘i∈∘ set {0, 1ℕ, 2ℕ}. Q i)"
    proof(intro vsubsetI)
      fix F assume "F ∈∘ 𝔊 CF↓CF ℌ⦇Arr⦈"
      then obtain abf a'b'f' where F: "F : abf ↦⇘𝔊 CF↓CF ℌ⇙ 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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
          and "f' : 𝔊⦇ObjMap⦈⦇a'⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b'⦈"
          and "f' ∘A⇘ℭ⇙ 𝔊⦇ArrMap⦈⦇g⦈ = ℌ⦇ArrMap⦈⦇h⦈ ∘A⇘ℭ⇙ f"
        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 "F⦇i⦈ ∈∘ 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 "𝔊 CF↓CF ℌ⦇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∈∘(𝔊 CF↓CF ℌ)⦇Obj⦈. [A⦇1ℕ⦈, A⦇0⦈, A⦇2ℕ⦈]∘)"


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 ∈∘ (𝔊 CF↓CF ℌ)⦇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 ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    "B ∈∘ 𝔊 CF↓CF ℌ⦇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 ℌ) CF↓CF (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 ℌ) CF↓CF (op_cf 𝔊)⦇Obj⦈"
  proof
    (
      intro vsv.vsv_vrange_vsubset op_cf_commma_obj_flip_vsv, 
      unfold cat_comma_cs_simps
    )
    fix A assume "A ∈∘ 𝔊 CF↓CF ℌ⦇Obj⦈"
    then obtain a b f
      where A_def: "A = [a, b, f]∘"
        and a: "a ∈∘ 𝔄⦇Obj⦈"
        and b: "b ∈∘ 𝔅⦇Obj⦈"
        and f: "f : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      by (elim cat_comma_ObjE[OF _ assms])
    from a b f show 
      "op_cf_commma_obj_flip 𝔊 ℌ⦇A⦈ ∈∘ (op_cf ℌ) CF↓CF (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 ℌ) CF↓CF (op_cf 𝔊)⦇Obj⦈ ⊆∘ ℛ∘ (op_cf_commma_obj_flip 𝔊 ℌ)"
  proof(intro vsubsetI)
    fix B assume "B ∈∘ (op_cf ℌ) CF↓CF (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 : 𝔊⦇ObjMap⦈⦇a⦈ ↦⇘ℭ⇙ ℌ⦇ObjMap⦈⦇b⦈"
      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 ⇒